!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!                                                                     !
!      DESCRIPTIONS                                                   !
!                                                                     !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!     
***********************************************************************
*                                                                     *
*       PEQL - LIMITED-MEMORY INVERSE COLUMN-UPDATE METHOD FOR        *
*              LARGE-SCALE SYSTEMS OF NONLINEAR EQUATIONS WITH        *
*              SPARSE JACOBIAN MATRICES.                              *
*                                                                     *
***********************************************************************

1. Introduction:
----------------

      The double-precision FORTRAN 77 basic subroutine PEQL is designed
to find a close approximation to a solution of nonlinear equations

      FA_1(X) = 0,  FA_2(X) = 0,  ...,  FA_N(X)=0.

Here X is a vector of N variables and FA_I(X), 1 <= I <= N, are twice
continuously differentiable functions. We assume that N is large, but
partial functions FA_I(X), 1 <= I <= N depend on a small number of
variables. Thus the mapping AF(X) = [FA_1(X), FA_2(X), ..., FA_N(X)]
has a sparse Jacobian matrix, which will be denoted by AG(X) (it has N
rows and N columns). The sparsity pattern of the Jacobian matrix is
stored in the coordinate form if ISPAS=1 or in the standard compressed
row format if ISPAS=2 using arrays IAG and JAG. For example, if the
Jacobian matrix has the following pattern

                AG = | * * 0 * |
                     | * * * 0 |
                     | * 0 0 * |
                     | 0 * * 0 |

(asterisks denote nonzero elements) then arrays IAG and JAG contain
elements

IAG(1)=1, IAG(2)=1, IAG(3)=1, IAG(4)=2,  IAG(5)=2,  IAG(6)=2,
IAG(7)=3, IAG(8)=3, IAG(9)=4, IAG(10)=4,
JAG(1)=1, JAG(2)=2, JAG(3)=4, JAG(4)=1,  JAG(5)=2,  JAG(6)=3,
JAG(7)=1, JAG(8)=4, JAG(9)=2, JAG(10)=3

if ISPAS=1 or

IAG(1)=1, IAG(2)=4, IAG(3)=7, IAG(4)=9,  IAG(5)=11,
JAG(1)=1, JAG(2)=2, JAG(3)=4, JAG(4)=1,  JAG(5)=2,  JAG(6)=3,
JAG(7)=1, JAG(8)=4, JAG(9)=2, JAG(10)=3

if ISPAS=2. In the first case, nonzero elements can be sorted in an
arbitrary order (not only by rows as in the above example). Arrays
IAG and JAG have to be declared with lengths N+MA and MA at least,
respectively, where MA is the number of nonzero elements. In the
second case, nonzero elements can be sorted only by rows. Components
of IAG contain total numbers of nonzero elements in all previous
rows increased by 1 and elements of JAG contain corresponding column
indices (note that IAG has N+1 elements and the last element is
equal to MA+1). Arrays IAG and JAG have to be declared with length
N+1 and MA at least, respectively.
      To simplify user's work, an additional easy to use subroutine
PEQLU is added. It calls the basic general subroutine PEQL. All
subroutines contain a description of formal parameters and extensive
comments. Furthermore, test program TEQLU is included, which contains
several test problems (see e.g. [2]). This test program serves as an
example for using the subroutine PEQLU, verifies its correctness and
demonstrates its efficiency.
      In this short guide, we describe all subroutines which can be
called from the user's program. A detailed description of the method is
given in [1]. 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/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH

The arguments have the following meaning:

 Argument  Type Significance
 ----------------------------------------------------------------------
  NRES      O   Positive INTEGER variable that indicates the number of
                restarts.
  NDEC      O   Positive INTEGER variable that indicates the number of
                matrix decompositions.
  NIN       O   Positive INTEGER variable that indicates the number of
                inner iterations (for solving linear systems).
  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. Subroutine PEQLU:
--------------------

The calling sequence is

      CALL PEQLU(N,MA,X,AF,IAG,JAG,IPAR,RPAR,F,GMAX,IDER,ISPAS,IPRNT,ITERM)

The arguments have the following meaning.

 Argument  Type Significance
 ----------------------------------------------------------------------
  N         I   Positive INTEGER variable that specifies the number of
                variables of the partially separable function.
  MA        I   Number of nonzero elements in the Jacobian matrix. This
                parameter is used as input only if ISPAS=1 (it defines
                dimensions of arrays IAG and JAG in this case).
  X(N)      U   On input, DOUBLE PRECISION vector with the initial
                estimate to the solution. On output, the approximation
                to the minimum.
  AF(N)     O   DOUBLE PRECISION vector which contains values of partial
                functions.
  IAG(N+1)  I   INTEGER array which contains pointers of the first
                elements in rows of the Jacobian matrix.
  JAG(MA)   I   INTEGER array which contains column indices of the
                nonzero elements.
  IPAR(7)   I   INTEGER parameters:
                  IPAR(1)=MIT,  IPAR(2)=MFV,   IPAR(3)-NONE,
                  IPAR(4)-NONE, IPAR(5)=MOS1,  IPAR(6)=MOS2,
                  IPAR(7)=MF.
                Parameters MIT, MFV, MOS1, MOS2, MF are described in
                Section 3 together with other parameters of the
                subroutine PEQL.
  RPAR(9)   I   DOUBLE PRECISION parameters:
                  RPAR(1)=XMAX,  RPAR(2)=TOLX,  RPAR(3)=TOLF,
                  RPAR(4)=TOLB,  RPAR(5)=TOLG,  RPAR(6)-NONE,
                  RPAR(7)-NONE,  RPAR(8)=ETA2,  RPAR(9)-NONE.
                Parameters XMAX, TOLX, TOLF, TOLB, TOLG, ETA2 are
                described in Section 3 together with other parameters
                of the subroutine PEQL.
  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.
  IDER      I   INGEGER variable that specifies the degree of analytically
                computed derivatives (0 OR 1).
  ISPAS     I   INTEGER variable that specifies sparse structure of the
                Jacobian matrix:
                  ISPAS= 1 - the coordinate form is used,
                  ISPAS= 2 - the standard row compresed format is used.
  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.
  ITERM     O   INTEGER variable that indicates the cause of termination:
                  ITERM= 1 - if |X - XO| was less than or equal to TOLX
                             in two subsequent iterations,
                  ITERM= 2 - if |F - FO| was less than or equal to TOLF
                             in two 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= 6 - if termination criterion was not satisfied,
                             but the solution is probably acceptable,
                  ITERM=11 - if NIT exceeded MIT,
                  ITERM=12 - if NFV exceeded MFV,
                  ITERM< 0 - if the method failed.

      The subroutines PEQLU requires the user supplied subroutines
FUN and DFUN that define partial functions and their gradients and have
the form

      SUBROUTINE  FUN(NF,KA,X,FA)
      SUBROUTINE DFUN(NF,KA,X,GA)

If IDER=0, the subroutine DFUN can be empty. The arguments of the user
supplied subroutines have the following meaning.

 Argument  Type Significance
 ----------------------------------------------------------------------
  N         I   Positive INTEGER variable that specifies the number of
                variables of the objective function.
  KA        I   INTEGER index of the partial function.
  X(N)      I   DOUBLE PRECISION an estimate to the solution.
  FA        O   DOUBLE PRECISION value of the KA-th partial function at
                the point X.


3. Subroutine PEQL:
-------------------

      This general subroutine is called from all subroutines described
in Section 2. The calling sequence is

      CALL PEQL(N,X,GA,AG,IAG,JAG,IB,IW1,IW2,IW3,IW4,XM,GM,IM,G,S,XO,
     & GO,XS,GS,XP,GP,AF,AFO,AFD,XMAX,TOLX,TOLF,TOLB,TOLG,ETA2,GMAX,
     & F,MIT,MFV,MOS1,MOS2,MF,IDER,IPRNT,ITERM)

The arguments N, X, IAG, JAG, AF, GMAX, F, IDER, IPRNT, ITERM have the
same meaning as in Section 2. Other arguments have the following meaning:

 Argument  Type Significance
 ----------------------------------------------------------------------
  GA(N)      A   DOUBLE PRECISION gradient of the partial function.
  AG(MA)     A   DOUBLE PRECISION nonzero elements of the Jacobian
                 matrix.
  IB(N)      A   INTEGER permutation vector.
  IW1(N)     A   INTEGER auxiliary array.
  IW2(N)     A   INTEGER auxiliary array.
  IW3(N)     A   INTEGER auxiliary array.
  IW4(N)     A   INTEGER auxiliary array.
  XM(N*MF)   A   DOUBLE PRECISION array which contains vectors for
                 inverse column-update.
  GM(MF)     A   DOUBLE PRECISION array which contains values for
                 inverse column-update.
  IM(MF)     A   INTEGER array which contains indices for inverse
                 column-update.
  G(N)       A   DOUBLE PRECISION gradient of the objective function.
  S(N)       A   DOUBLE PRECISION direction vector.
  XO(N)      A   DOUBLE PRECISION array which contains increments of
                 variables.
  GO(N)      A   DOUBLE PRECISION array which contains increments of
                 gradients.
  XS(N)      A   DOUBLE PRECISION auxiliary array.
  GS(N)      A   DOUBLE PRECISION auxiliary array.
  XP(N)      A   DOUBLE PRECISION auxiliary array.
  GP(N)      A   DOUBLE PRECISION auxiliary array.
  AFO(N)     A   DOUBLE PRECISION vector which contains old values of
                 partial functions.
  AFD(N)     A   DOUBLE PRECISION auxiliary array.
  XMAX       I   DOUBLE PRECISION maximum stepsize; the choice XMAX=0
                 causes that the default value 1.0D+16 will be taken.
  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-16 will be taken.
  TOLB      I   DOUBLE PRECISION minimum acceptable function value;
                the choice TOLB=0 causes that the default value
                TOLB=1.0D-16 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.
  ETA2      I   DOUBLE PRECISION damping parametr for an incomplete
                LU preconditioner.
  MIT       I   INTEGER variable that specifies the maximum number of
                iterations; the choice MIT=0 causes that the default
                value 1000 will be taken.
  MFV       I   INTEGER variable that specifies the maximum number of
                function evaluations; the choice MFV=0 causes that
                the default value 1000 will be taken.
  MOS1      I   INTEGER variable that specifies the smoothing strategy
                for the CGS method:
                  MOS1=1 - smoothing is not used.
                  MOS1=2 - single smoothing strategy is used.
                  MOS1=3 - double smoothing strategy is used.
                The choice MOS1=0 causes that the default value MOS1=3
                will be taken.
  MOS2      I   INTEGER choice of preconditioning strategy:
                  MOS2=1 - preconditioning is not used.
                  MOS2=2 - preconditioning by the incomplete LU
                           decomposition.
                  MOS2=3 - preconditioning by the incomplete LU
                           decomposition combined with preliminary
                           solution of the preconditioned system.
  MF        I   The number of limited-memory variable metric updates
                in each iteration (they use 2*MF stored vectors).

The choice of parameter XMAX can be sensitive in many cases. First,
partial functions can be evaluated only in a relatively small region
(if it contains exponentials) so that the maximum stepsize is necessary.
Secondly, the problem can be very ill-conditioned far from the solution
point so that large steps can be unsuitable. Finally, if the problem has
more local solutions, a suitably chosen maximum stepsize can lead to
obtaining a better local solution.
      The subroutine PEQL requires the user supplied subroutine FUN
which is described in Section 2.

4. Verification of the subroutines:
-----------------------------------

      Subroutine PEQLU can be verified and tested using the program
TEQLU. This program calls the subroutines TIUB18 (initiation), TAFU18
(function evaluation) and TAGU18 (gradient evaluation) containing
30 unconstrained test problems with at most 5000 variables [2]. The
results obtained by the program TEQLU on a PC computer with Microsoft
Power Station Fortran compiler have the following form.

NIT=   30  NFV=   64  NFG=    0  F= 0.326079E-18  G= 0.154142E-03  ITERM=  3
NIT=   17  NFV=   57  NFG=    0  F= 0.720058E-19  G= 0.261551E-07  ITERM=  3
NIT=    5  NFV=   11  NFG=    0  F= 0.861220E-16  G= 0.366389E-03  ITERM=  3
NIT=   11  NFV=   19  NFG=    0  F= 0.115060E-18  G= 0.358897E-01  ITERM=  3
NIT=   20  NFV=   56  NFG=    0  F= 0.335602E-16  G= 0.121910E-06  ITERM=  3
NIT=   22  NFV=   31  NFG=    0  F= 0.167377E-16  G= 0.898624E-08  ITERM=  3
NIT=   25  NFV=   42  NFG=    0  F= 0.137004E-20  G= 0.185851E-05  ITERM=  3
NIT=   21  NFV=   60  NFG=    0  F= 0.496243E-28  G= 0.183782E-07  ITERM=  3
NIT=   32  NFV=   71  NFG=    0  F= 0.220876E-21  G= 0.800603E-05  ITERM=  3
NIT=    9  NFV=   24  NFG=    0  F= 0.202316E-20  G= 0.162996E-03  ITERM=  3
NIT=   16  NFV=   23  NFG=    0  F= 0.116022E-21  G= 0.130018E-02  ITERM=  3
NIT=   23  NFV=   40  NFG=    0  F= 0.861690E-16  G= 0.190460E-08  ITERM=  3
NIT=   24  NFV=   32  NFG=    0  F= 0.234892E-16  G= 0.204525E-08  ITERM=  3
NIT=    8  NFV=   13  NFG=    0  F= 0.596974E-21  G= 0.811563E-05  ITERM=  3
NIT=   12  NFV=   28  NFG=    0  F= 0.124901E-17  G= 0.305897      ITERM=  3
NIT=   22  NFV=   78  NFG=    0  F= 0.984840E-20  G= 0.125407E-03  ITERM=  3
NIT=   17  NFV=   43  NFG=    0  F= 0.130235E-20  G= 0.154659E-04  ITERM=  3
NIT=   46  NFV=   61  NFG=    0  F= 0.224793E-17  G= 0.116353E-01  ITERM=  3
NIT=    2  NFV=    5  NFG=    0  F= 0.704403E-18  G= 0.221630E-06  ITERM=  3
NIT=   18  NFV=   30  NFG=    0  F= 0.158787E-16  G= 0.312477E-03  ITERM=  3
NIT=   25  NFV=   34  NFG=    0  F= 0.233925E-16  G= 0.135133E-05  ITERM=  3
NIT=   14  NFV=   45  NFG=    0  F= 0.189862E-17  G= 0.128826E-01  ITERM=  3
NIT=   23  NFV=  106  NFG=    0  F= 0.194742E-18  G= 0.550497E-08  ITERM=  3
NIT=   20  NFV=   53  NFG=    0  F= 0.737500E-17  G= 0.611156E-08  ITERM=  3
NIT=   29  NFV=   50  NFG=    0  F= 0.208794E-17  G= 0.413643E-08  ITERM=  3
NIT=   36  NFV=   67  NFG=    0  F= 0.132055E-17  G= 0.481013E-08  ITERM=  3
NIT=   40  NFV=   75  NFG=    0  F= 0.659356E-17  G= 0.862034E-08  ITERM=  3
NIT=   27  NFV=   83  NFG=    0  F= 0.461856E-18  G= 0.268680E-08  ITERM=  3
NIT=   12  NFV=   95  NFG=    0  F= 0.206962E-16  G= 0.754042E-08  ITERM=  3
NIT=   18  NFV=  145  NFG=    0  F= 0.740533E-16  G= 0.167985E-07  ITERM=  3
NITER =  624    NFVAL = 1541    NSUCC =   30
TIME= 0:00:04.13

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
(sum of squares of the partial functions), the value of the criterion
for the termination G and the cause of termination ITERM.

References:
-----------

[1] Luksan L., Matonoha C., Vlcek J.: LSA: Algorithms for large-scale
    unconstrained and box constrained optimization Technical Report V-896.
    Prague, ICS AS CR, 2004.

[2] Luksan L., Vlcek J.: Sparse and partially separable test problems
    for unconstrained and equality constrained optimization. Research
    Report V-767, Institute of Computer Science, Academy of Sciences
    of the Czech Republic, Prague, Czech Republic, 1998.

***********************************************************************
*                                                                     *
*       PEQN - DISCRETE NEWTON METHOD FOR LARGE-SCALE SYSTEMS OF      *
*              NONLINEAR EQUATIONS WITH SPARSE JACOBIAN MATRICES.     *
*                                                                     *
***********************************************************************

1. Introduction:
----------------

      The double-precision FORTRAN 77 basic subroutine PEQN is designed
to find a close approximation to a solution of nonlinear equations

      FA_1(X) = 0,  FA_2(X) = 0,  ...,  FA_N(X)=0.

Here X is a vector of N variables and FA_I(X), 1 <= I <= N, are twice
continuously differentiable functions. We assume that N is large, but
partial functions FA_I(X), 1 <= I <= N depend on a small number of
variables. Thus the mapping AF(X) = [FA_1(X), FA_2(X), ..., FA_N(X)]
has a sparse Jacobian matrix, which will be denoted by AG(X) (it has N
rows and N columns). The sparsity pattern of the Jacobian matrix is
stored in the coordinate form if ISPAS=1 or in the standard compressed
row format if ISPAS=2 using arrays IAG and JAG. For example, if the
Jacobian matrix has the following pattern

                AG = | * * 0 * |
                     | * * * 0 |
                     | * 0 0 * |
                     | 0 * * 0 |

(asterisks denote nonzero elements) then arrays IAG and JAG contain
elements

IAG(1)=1, IAG(2)=1, IAG(3)=1, IAG(4)=2,  IAG(5)=2,  IAG(6)=2,
IAG(7)=3, IAG(8)=3, IAG(9)=4, IAG(10)=4,
JAG(1)=1, JAG(2)=2, JAG(3)=4, JAG(4)=1,  JAG(5)=2,  JAG(6)=3,
JAG(7)=1, JAG(8)=4, JAG(9)=2, JAG(10)=3

if ISPAS=1 or

IAG(1)=1, IAG(2)=4, IAG(3)=7, IAG(4)=9,  IAG(5)=11,
JAG(1)=1, JAG(2)=2, JAG(3)=4, JAG(4)=1,  JAG(5)=2,  JAG(6)=3,
JAG(7)=1, JAG(8)=4, JAG(9)=2, JAG(10)=3

if ISPAS=2. In the first case, nonzero elements can be sorted in an
arbitrary order (not only by rows as in the above example). Arrays
IAG and JAG have to be declared with lengths N+MA and MA at least,
respectively, where MA is the number of nonzero elements. In the
second case, nonzero elements can be sorted only by rows. Components
of IAG contain total numbers of nonzero elements in all previous
rows increased by 1 and elements of JAG contain corresponding column
indices (note that IAG has N+1 elements and the last element is
equal to MA+1). Arrays IAG and JAG have to be declared with length
N+1 and MA at least, respectively.
      To simplify user's work, an additional easy to use subroutine
PEQNU is added. It calls the basic general subroutine PEQN. All
subroutines contain a description of formal parameters and extensive
comments. Furthermore, test program TEQNU is included, which contains
several test problems (see e.g. [2]). This test program serves as an
example for using the subroutine PEQNU, verifies its correctness and
demonstrates its efficiency.
      In this short guide, we describe all subroutines which can be
called from the user's program. A detailed description of the method is
given in [1]. 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/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH

The arguments have the following meaning:

 Argument  Type Significance
 ----------------------------------------------------------------------
  NRES      O   Positive INTEGER variable that indicates the number of
                restarts.
  NDEC      O   Positive INTEGER variable that indicates the number of
                matrix decompositions.
  NIN       O   Positive INTEGER variable that indicates the number of
                inner iterations (for solving linear systems).
  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. Subroutine PEQNU:
--------------------

The calling sequence is

      CALL PEQNU(N,MA,X,AF,IAG,JAG,IPAR,RPAR,F,GMAX,IDER,ISPAS,IPRNT,ITERM)

The arguments have the following meaning.

 Argument  Type Significance
 ----------------------------------------------------------------------
  N         I   Positive INTEGER variable that specifies the number of
                variables of the partially separable function.
  MA        I   Number of nonzero elements in the Jacobian matrix. This
                parameter is used as input only if ISPAS=1 (it defines
                dimensions of arrays IAG and JAG in this case).
  X(N)      U   On input, DOUBLE PRECISION vector with the initial
                estimate to the solution. On output, the approximation
                to the minimum.
  AF(N)     O   DOUBLE PRECISION vector which contains values of partial
                functions.
  IAG(N+1)  I   INTEGER array which contains pointers of the first
                elements in rows of the Jacobian matrix.
  JAG(MA)   I   INTEGER array which contains column indices of the
                nonzero elements.
  IPAR(7)   I   INTEGER parameters:
                  IPAR(1)=MIT,  IPAR(2)=MFV,   IPAR(3)-NONE,
                  IPAR(4)-NONE, IPAR(5)=MOS1,  IPAR(6)=MOS2,
                  IPAR(7)-NONE.
                Parameters MIT, MFV, MOS1, MOS2 are described in
                Section 3 together with other parameters of the
                subroutine PEQN.
  RPAR(9)   I   DOUBLE PRECISION parameters:
                  RPAR(1)=XMAX,  RPAR(2)=TOLX,  RPAR(3)=TOLF,
                  RPAR(4)=TOLB,  RPAR(5)=TOLG,  RPAR(6)-NONE,
                  RPAR(7)-NONE,  RPAR(8)=ETA2,  RPAR(9)-NONE.
                Parameters XMAX, TOLX, TOLF, TOLB, TOLG, ETA2 are
                described in Section 3 together with other parameters
                of the subroutine PEQN.
  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.
  IDER      I   INGEGER variable that specifies the degree of analytically
                computed derivatives (0 OR 1).
  ISPAS     I   INTEGER variable that specifies sparse structure of the
                Jacobian matrix:
                  ISPAS= 1 - the coordinate form is used,
                  ISPAS= 2 - the standard row compresed format is used.
  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.
  ITERM     O   INTEGER variable that indicates the cause of termination:
                  ITERM= 1 - if |X - XO| was less than or equal to TOLX
                             in two subsequent iterations,
                  ITERM= 2 - if |F - FO| was less than or equal to TOLF
                             in two 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= 6 - if termination criterion was not satisfied,
                             but the solution is probably acceptable,
                  ITERM=11 - if NIT exceeded MIT,
                  ITERM=12 - if NFV exceeded MFV,
                  ITERM< 0 - if the method failed.

      The subroutines PEQNU requires the user supplied subroutines
FUN and DFUN that define partial functions and their gradients and have
the form

      SUBROUTINE  FUN(NF,KA,X,FA)
      SUBROUTINE DFUN(NF,KA,X,GA)

If IDER=0, the subroutine DFUN can be empty. The arguments of the user
supplied subroutines have the following meaning.

 Argument  Type Significance
 ----------------------------------------------------------------------
  N         I   Positive INTEGER variable that specifies the number of
                variables of the objective function.
  KA        I   INTEGER index of the partial function.
  X(N)      I   DOUBLE PRECISION an estimate to the solution.
  FA        O   DOUBLE PRECISION value of the KA-th partial function at
                the point X.


3. Subroutine PEQN:
-------------------

      This general subroutine is called from all subroutines described
in Section 2. The calling sequence is

      CALL PEQN(N,X,GA,AG,IAG,JAG,IB,IW1,IW2,IW3,IW4,G,S,XO,GO,XS,GS,
     & XP,GP,AF,AFO,AFD,XMAX,TOLX,TOLF,TOLB,TOLG,ETA2,GMAX,F,MIT,MFV,
     & MOS1,MOS2,IDER,IPRNT,ITERM)

The arguments N, X, IAG, JAG, AF, GMAX, F, IDER, IPRNT, ITERM have the
same meaning as in Section 2. Other arguments have the following meaning:

 Argument  Type Significance
 ----------------------------------------------------------------------
  GA(N)      A   DOUBLE PRECISION gradient of the partial function.
  AG(MA)     A   DOUBLE PRECISION nonzero elements of the Jacobian
                 matrix.
  IB(N)      A   INTEGER permutation vector.
  IW1(N)     A   INTEGER auxiliary array.
  IW2(N)     A   INTEGER auxiliary array.
  IW3(N)     A   INTEGER auxiliary array.

  IW4(N)     A   INTEGER auxiliary array.
  G(N)       A   DOUBLE PRECISION gradient of the objective function.
  S(N)       A   DOUBLE PRECISION direction vector.
  XO(N)      A   DOUBLE PRECISION array which contains increments of
                 variables.
  GO(N)      A   DOUBLE PRECISION array which contains increments of
                 gradients.
  XS(N)      A   DOUBLE PRECISION auxiliary array.
  GS(N)      A   DOUBLE PRECISION auxiliary array.
  XP(N)      A   DOUBLE PRECISION auxiliary array.
  GP(N)      A   DOUBLE PRECISION auxiliary array.
  AFO(N)     A   DOUBLE PRECISION vector which contains old values of
                 partial functions.
  AFD(N)     A   DOUBLE PRECISION auxiliary array.
  XMAX       I   DOUBLE PRECISION maximum stepsize; the choice XMAX=0
                 causes that the default value 1.0D+16 will be taken.
  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-16 will be taken.
  TOLB      I   DOUBLE PRECISION minimum acceptable function value;
                the choice TOLB=0 causes that the default value
                TOLB=1.0D-16 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.
  ETA2      I   DOUBLE PRECISION damping parametr for an incomplete
                LU preconditioner.
  MIT       I   INTEGER variable that specifies the maximum number of
                iterations; the choice MIT=0 causes that the default
                value 1000 will be taken.
  MFV       I   INTEGER variable that specifies the maximum number of
                function evaluations; the choice MFV=0 causes that
                the default value 1000 will be taken.
  MOS1      I   INTEGER variable that specifies the smoothing strategy
                for the CGS method:
                  MOS1=1 - smoothing is not used.
                  MOS1=2 - single smoothing strategy is used.
                  MOS1=3 - double smoothing strategy is used.
                The choice MOS1=0 causes that the default value MOS1=3
                will be taken.
  MOS2      I   INTEGER choice of preconditioning strategy:
                  MOS2=1 - preconditioning is not used.
                  MOS2=2 - preconditioning by the incomplete LU
                           decomposition.
                  MOS2=3 - preconditioning by the incomplete LU
                           decomposition combined with preliminary
                           solution of the preconditioned system.

The choice of parameter XMAX can be sensitive in many cases. First,
partial functions can be evaluated only in a relatively small region
(if it contains exponentials) so that the maximum stepsize is necessary.
Secondly, the problem can be very ill-conditioned far from the solution
point so that large steps can be unsuitable. Finally, if the problem has
more local solutions, a suitably chosen maximum stepsize can lead to
obtaining a better local solution.
      The subroutine PEQN requires the user supplied subroutine FUN
which is described in Section 2.

4. Verification of the subroutines:
-----------------------------------

      Subroutine PEQNU can be verified and tested using the program
TEQNU. This program calls the subroutines TIUB18 (initiation), TAFU18
(function evaluation) and TAGU18 (gradient evaluation) containing
30 unconstrained test problems with at most 5000 variables [2]. The
results obtained by the program TEQNU on a PC computer with Microsoft
Power Station Fortran compiler have the following form.

NIT=   10  NFV=   41  NFG=    0  F= 0.224531E-22  G= 0.168207E-07  ITERM=  3
NIT=    9  NFV=   46  NFG=    0  F= 0.106897E-22  G= 0.163517E-06  ITERM=  3
NIT=    3  NFV=   19  NFG=    0  F= 0.333989E-19  G= 0.223053E-06  ITERM=  3
NIT=    7  NFV=   23  NFG=    0  F= 0.348196E-17  G= 0.177085E-02  ITERM=  3
NIT=   12  NFV=   63  NFG=    0  F= 0.117206E-16  G= 0.694210E-06  ITERM=  3
NIT=   17  NFV=   52  NFG=    0  F= 0.110919E-16  G= 0.167579E-11  ITERM=  3
NIT=   13  NFV=   41  NFG=    0  F= 0.339913E-19  G= 0.457009E-03  ITERM=  3
NIT=   13  NFV=   73  NFG=    0  F= 0.125748E-25  G= 0.193922E-04  ITERM=  3
NIT=   13  NFV=   99  NFG=    0  F= 0.432936E-21  G= 0.201706E-03  ITERM=  3
NIT=    5  NFV=   41  NFG=    0  F= 0.803846E-25  G= 0.415983E-03  ITERM=  3
NIT=   12  NFV=   37  NFG=    0  F= 0.189327E-25  G= 0.423583E-05  ITERM=  3
NIT=   18  NFV=   55  NFG=    0  F= 0.129272E-16  G= 0.713317E-13  ITERM=  3
NIT=   18  NFV=   39  NFG=    0  F= 0.105290E-16  G= 0.341327E-13  ITERM=  3
NIT=    4  NFV=   13  NFG=    0  F= 0.774783E-20  G= 0.441968E-05  ITERM=  3
NIT=    5  NFV=   36  NFG=    0  F= 0.182567E-17  G= 0.471251E-03  ITERM=  3
NIT=   53  NFV=  319  NFG=    0  F= 0.462169E-17  G= 0.153957      ITERM=  3
NIT=   14  NFV=   48  NFG=    0  F= 0.449140E-22  G= 0.105525E-03  ITERM=  3
NIT=   27  NFV=   82  NFG=    0  F= 0.249708E-20  G= 0.571681E-05  ITERM=  3
NIT=    2  NFV=    7  NFG=    0  F= 0.309324E-21  G= 0.370062E-09  ITERM=  3
NIT=   13  NFV=   43  NFG=    0  F= 0.428279E-20  G= 0.203421E-07  ITERM=  3
NIT=   12  NFV=   37  NFG=    0  F= 0.200623E-20  G= 0.255404E-10  ITERM=  3
NIT=    7  NFV=   50  NFG=    0  F= 0.195350E-19  G= 0.106707E-05  ITERM=  3
NIT=   29  NFV=  262  NFG=    0  F= 0.390327E-17  G= 0.200697E-10  ITERM=  3
NIT=    6  NFV=   31  NFG=    0  F= 0.822526E-23  G= 0.812457E-09  ITERM=  3
NIT=    9  NFV=   46  NFG=    0  F= 0.147127E-23  G= 0.395357E-09  ITERM=  3
NIT=   12  NFV=   61  NFG=    0  F= 0.608837E-17  G= 0.420862E-07  ITERM=  3
NIT=   10  NFV=   51  NFG=    0  F= 0.275078E-20  G= 0.121824E-06  ITERM=  3
NIT=   10  NFV=   60  NFG=    0  F= 0.229532E-16  G= 0.213811E-05  ITERM=  3
NIT=    4  NFV=   53  NFG=    0  F= 0.124549E-19  G= 0.130673E-05  ITERM=  3
NIT=   12  NFV=  162  NFG=    0  F= 0.222959E-21  G= 0.107876E-07  ITERM=  3
NITER =  379    NFVAL = 1990    NSUCC =   30
TIME= 0:00:04.77

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
(sum of squares of the partial functions), the value of the criterion
for the termination G and the cause of termination ITERM.

References:
-----------

[1] Luksan L., Matonoha C., Vlcek J.: LSA: Algorithms for large-scale
    unconstrained and box constrained optimization Technical Report V-896.
    Prague, ICS AS CR, 2004.

[2] Luksan L., Vlcek J.: Sparse and partially separable test problems
    for unconstrained and equality constrained optimization. Research
    Report V-767, Institute of Computer Science, Academy of Sciences
    of the Czech Republic, Prague, Czech Republic, 1998.

***********************************************************************
*                                                                     *
*   PGAC - HYBRID GAUSS-NEWTON METHOD WITH SECOND-ORDER CORRECTIONS   *
*          AND ITERATIVE CG-BASED TRUST-REGION SUBALGORITHMS FOR      *
*          LARGE-SCALE PARTIALLY SEPARABLE LEAST SQUARES PROBLEMS.    *
*                                                                     *
***********************************************************************


1. Introduction:
----------------

      The double-precision FORTRAN 77 basic subroutine PGAC is designed
to find a close approximation to a local minimum of a sum of squares

      F(X) =  FA_1(X)**2 + FA_2(X)**2 + ... + FA_NA(X)**2

with simple bounds on variables. Here X is a vector of NF variables and
FA_I(X), 1 <= I <= NA, are twice continuously differentiable functions.
We assume that NF and NA are large, but partial functions FA_I(X),
1 <= I <= NA depend on a small number of variables. This implies that
the mapping AF(X) = [FA_1(X), FA_2(X), ..., FA_NA(X)] has a sparse
Jacobian matrix, which will be denoted by AG(X) (it has NA rows and NF
columns). 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 <= NF. The sparsity pattern of the Jacobian matrix is
stored in the coordinate form if ISPAS=1 or in the standard compressed
row format if ISPAS=2 using arrays IAG and JAG. For example, if the
Jacobian matrix has the following pattern

                AG = | * * 0 * |
                     | * * * 0 |
                     | * 0 0 * |
                     | 0 * * 0 |
                     | * 0 * 0 |

(asterisks denote nonzero elements) then arrays IAG and JAG contain
elements

IAG(1)=1, IAG(2)=1, IAG(3)=1, IAG(4)=2,  IAG(5)=2,  IAG(6)=2,
IAG(7)=3, IAG(8)=3, IAG(9)=4, IAG(10)=4, IAG(11)=5, IAG(12)=5,
JAG(1)=1, JAG(2)=2, JAG(3)=4, JAG(4)=1,  JAG(5)=2,  JAG(6)=3,
JAG(7)=1, JAG(8)=4, JAG(9)=2, JAG(10)=3, JAG(11)=1, JAG(12)=3

if ISPAS=1 or

IAG(1)=1, IAG(2)=4, IAG(3)=7, IAG(4)=9,  IAG(5)=11, IAG(6)=13,
JAG(1)=1, JAG(2)=2, JAG(3)=4, JAG(4)=1,  JAG(5)=2,  JAG(6)=3,
JAG(7)=1, JAG(8)=4, JAG(9)=2, JAG(10)=3, JAG(11)=1, JAG(12)=3

if ISPAS=2. In the first case, nonzero elements can be sorted in an
arbitrary order (not only by rows as in the above example). Arrays
IAG and JAG have to be declared with lengths NA+MA and MA at least,
respectively, where MA is the number of nonzero elements. In the
second case, nonzero elements can be sorted only by rows. Components
of IAG contain total numbers of nonzero elements in all previous
rows increased by 1 and elements of JAG contain corresponding column
indices (note that IAG has NA+1 elements and the last element is
equal to MA+1). Arrays IAG and JAG have to be declared with length
NA+1 and MA at least, respectively.
      To simplify user's work, two additional easy to use subroutines
are added. They call the basic general subroutine PGAC:

      PGACU - unconstrained large-scale optimization,
      PGACS - large-scale optimization with simple bounds.

All subroutines contain a description of formal parameters and
extensive comments. Furthermore, two test programs TGACU and TGACS are
included, which contain several test problems (see e.g. [2]). 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 the method is
given in [1]. 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/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH

The arguments have the following meaning:

 Argument  Type Significance
 ----------------------------------------------------------------------
  NRES      O   Positive INTEGER variable that indicates the number of
                restarts.
  NDEC      O   Positive INTEGER variable that indicates the number of
                matrix decompositions.
  NIN       O   Positive INTEGER variable that indicates the number of
                inner iterations (for solving linear systems).
  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 PGACU, PGACS:
----------------------------

The calling sequences are

      CALL PGACU(NF,NA,MA,X,AF,IAG,JAG,IPAR,RPAR,F,GMAX,IDER,ISPAS,IPRNT,
     & ITERM)
      CALL PGACS(NF,NA,MA,X,IX,XL,XU,AF,IAG,JAG,IPAR,RPAR,F,GMAX,IDER,
     & ISPAS,IPRNT,ITERM)

The arguments have the following meaning.

 Argument  Type Significance
 ----------------------------------------------------------------------
  NF        I   Positive INTEGER variable that specifies the number of
                variables of the partially separable function.
  NA        I   Positive INTEGER variable that specifies the number of
                partial functions.
  MA        I   Number of nonzero elements in the Jacobian matrix. This
                parameter is used as input only if ISPAS=1 (it defines
                dimensions of arrays IAG and JAG in this case).
  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).
  AF(NA)    O   DOUBLE PRECISION vector which contains values of partial
                functions.
  IAG(NA+1) I   INTEGER array which contains pointers of the first
                elements in rows of the Jacobian matrix.
  JAG(MA)   I   INTEGER array which contains column indices of the
                nonzero elements.
  IPAR(7)   I   INTEGER parameters:
                  IPAR(1)=MIT,  IPAR(2)=MFV,  IPAR(3)=MFG,
                  IPAR(4)=MEC,  IPAR(5)=MOS1, IPAR(6)=MOS2,
                  IPAR(7)=IFIL.
                Parameters MIT, MFV, MFG, MEC, MOS1, MOS2 are described
                in Section 3 together with other parameters of the
                subroutine PGAC. Parameter IFIL specifies a relative
                size of the space reserved for fill-in. The choice
                IFIL=0 causes that the default value IFIL=1 will be
                taken.
  RPAR(9)   I   DOUBLE PRECISION parameters:
                  RPAR(1)=XMAX,  RPAR(2)=TOLX,  RPAR(3)=TOLF,
                  RPAR(4)=TOLB,  RPAR(5)=TOLG,  RPAR(6)=FMIN,
                  RPAR(7)=XDEL,  RPAR(8)=ETA,   RPAR(9)-NONE.
                Parameters XMAX, TOLX, TOLF, TOLB, TOLG, FMIN, XDEL,
                ETA are described in Section 3 together with other
                parameters of the subroutine PGAC.
  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.
  IDER      I   INGEGER variable that specifies the degree of analytically
                computed derivatives (0 OR 1).
  ISPAS     I   INTEGER variable that specifies sparse structure of the
                Jacobian matrix:
                  ISPAS= 1 - the coordinate form is used,
                  ISPAS= 2 - the standard row compresed format is used.
  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.
  ITERM     O   INTEGER variable that indicates the cause of termination:
                  ITERM= 1 - if |X - XO| was less than or equal to TOLX
                             in two subsequent iterations,
                  ITERM= 2 - if |F - FO| was less than or equal to TOLF
                             in two 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= 6 - if termination criterion was not satisfied,
                             but the solution is probably acceptable,
                  ITERM=11 - if NIT exceeded MIT,
                  ITERM=12 - if NFV exceeded MFV,
                  ITERM=13 - if NFG exceeded MFG,
                  ITERM< 0 - if the method failed. Values ITERM<=-40
                             detect a lack of space. In this case,
                             parameter IPAR(7)=IFIL has to be increased
                             (IFIL=2, IFIL=3, etc.).

      The subroutines PGACU, PGACS require the user supplied subroutines
FUN and DFUN that define partial functions and their gradients and have
the form

      SUBROUTINE  FUN(NF,KA,X,FA)
      SUBROUTINE DFUN(NF,KA,X,GA)

If IDER=0, the subroutine DFUN can be empty. The arguments of the 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   INTEGER index of the partial function.
  X(NF)     I   DOUBLE PRECISION an estimate to the solution.
  FA        O   DOUBLE PRECISION value of the KA-th partial function at
                the point X.
  GA(NF)    O   DOUBLE PRECISION gradient of the KA-th partial function
                at the point X. Note that only nonzero elements of this
                gradient have to be assigned.

3. Subroutine PGAC:
-------------------

      This general subroutine is called from all subroutines described
in Section 2. The calling sequence is

      CALL PGAC(NF,NA,NB,MMAX,X,IX,XL,XU,AF,GA,AG,G,HA,AH,H,IH,JH,IAG,
     & JAG,S,XO,GO,AGO,XS,GS,IW,XMAX,TOLX,TOLF,TOLB,TOLG,FMIN,XDEL,ETA,
     & GMAX,F,MIT,MFV,MFG,MEC,MOS1,MOS2,IDER,IPRNT,ITERM)

The arguments NF, NA, X, IX, XL, XU, AF, IAG, JAG, GMAX, F, IDER, IPRNT,
ITERM have the same meaning as in Section 2. Other arguments have the
following meaning:

 Argument  Type Significance
 ----------------------------------------------------------------------
  NB         I   Nonnegative INTEGER variable that specifies whether the
                 simple bounds are suppressed (NB=0) or accepted (NB>0).
  MMAX       I   INTEGER size of array H.
  GA(NF)     A   DOUBLE PRECISION gradient of the partial function.
  AG(MA)     A   DOUBLE PRECISION nonzero elements of the Jacobian
                 matrix. This array is used only if MEC=3.
  G(NF)      A   DOUBLE PRECISION gradient of the objective function.
  HA(ML)     A   DOUBLE PRECISION Hessian matrix of the partial function.
  AH(MH)     A   DOUBLE PRECISION approximation of the partitioned
                 Hessian matrix.
  H(MMAX)    A   DOUBLE PRECISION nonzero elements of the approximation
                 of the Hessian matrix and nonzero elements of the
                 Choleski factor.
  IH(NF+1)   I   INTEGER array which contains pointers of the diagonal
                 elements in the upper part of the Hessian matrix.
  JH(MMAX)   I   INTEGER array which contains column indices of the
                 nonzero elements and additional working space for the
                 Choleski factor.
  S(NF)      A   DOUBLE PRECISION direction vector.
  XO(NF)     A   DOUBLE PRECISION array which contains increments of
                 variables.
  GO(NF)     A   DOUBLE PRECISION array which contains increments of
                 gradients.
  AGO(MA)    A   DOUBLE PRECISION difference between the current and the
                 old Jacobian matrices. This array is used only if MEC=3.
  XS(NF)     A   DOUBLE PRECISION auxiliary array.
  GS(NF)     A   DOUBLE PRECISION auxiliary array.
  IW(NF+1)   A   INTEGER auxiliary array.
  XMAX       I   DOUBLE PRECISION maximum stepsize; the choice XMAX=0
                 causes that the default value 1.0D+16 will be taken.
  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-14 will be taken.
  TOLB       I   DOUBLE PRECISION minimum acceptable function value;
                 the choice TOLB=0 causes that the default value
                 TOLB=FMIN+1.0D-16 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.
  FMIN       I   DOUBLE PRECISION lower bound for the minimum function
                 value.
  XDEL       I   DOUBLE PRECISION trust region stepsize; the choice
                 XDEL=0 causes that a suitable default value is
                 computed.
  ETA        I   DOUBLE PRECISION parameter for switch between the
                 Gauss-Newton method and variable metric correction;
                 the choice ETA=0 causes that the default value
                 ETA=1.5D-4 will be taken.
  MIT        I   INTEGER variable that specifies the maximum number of
                 iterations; the choice MIT=0 causes that the default
                 value 5000 will be taken.
  MFV        I   INTEGER variable that specifies the maximum number of
                 function evaluations; the choice MFV=0 causes that
                 the default value 5000 will be taken.
  MFG        I   INTEGER variable that specifies the maximum number of
                 gradient evaluations; the choice MFV=0 causes that
                 the default value 10000 will be taken.
  MEC        I   INTEGER method of a second order correction:
                   MEC=1 - correction by the Marwil sparse variable
                           metric update,
                   MEC=2 - correction by differences of gradients
                           (discrete Newton correction).
                   MEC=3 - correction by the Griewank-Toint partitioned
                           variable metric update (symmetric rank-one).
                           This correction uses three additional
                           matrices (arrays AG, AGO and AH).
                 The choice MEC=0 causes that the default value 2 will
                 be taken.
  MOS1       I   INTEGER method for computing trust-region step:
                   MOS1=1 - Steihaug-Toint conjugate gradient method,
                   MOS1=2 - shifted Steihaug-Toint method with five
                            Lanczos steps.
                   MOS1>2 - shifted Steihaug-Toint method with MOS1
                            Lanczos steps.
                 The choice MOS1=0 causes that the default value 2 will
                 be taken.
  MOS2       I   INTEGER variable defining a type of preconditioning.
                   MOS2=1 - Preconditioning is not used.
                   MOS2=2 - Preconditioning by the incomplete Gill-Murray
                            decomposition.
                   MOS2=3 - Preconditioning by the incomplete Gill-Murray
                            decomposition with a preliminary solution of
                            the preconditioned system which is used if
                            it satisfies the termination criterion.
                 The choice MOS2=0 causes that the default value 2 will
                 be taken.

The choice of parameter XMAX can be sensitive in many cases. First, the
objective function can be evaluated only in a relatively small region
(if it contains exponentials) so that the maximum stepsize is necessary.
Secondly, the problem can be very ill-conditioned far from the solution
point so that large steps can be unsuitable. Finally, if the problem has
more local solutions, a suitably chosen maximum stepsize can lead to
obtaining a better local solution.
      The subroutine PGAC requires the user supplied subroutines FUN
and DFUN which are described in Section 2.

4. Verification of the subroutines:
-----------------------------------

      Subroutine PGACU can be verified and tested using the program
TGACU. This program calls the subroutines TIUB15 (initiation), TAFU15
(function evaluation) and TAGU15 (gradient evaluation) containing
22 unconstrained test problems with at most 1000 variables [2]. The
results obtained by the program TGACU on a PC computer with Microsoft
Power Station Fortran compiler have the following form.

NIT= 1108  NFV= 1110  NFG= 1110  F=  0.00000000      G= 0.000E+00  ITERM=  3
NIT=  624  NFV=  640  NFG=  649  F=  66.4089431      G= 0.283E-07  ITERM=  4
NIT=   11  NFV=   12  NFG=   14  F= 0.202412411E-09  G= 0.210E-06  ITERM=  4
NIT=   11  NFV=   13  NFG=   17  F=  134.749772      G= 0.592E-07  ITERM=  4
NIT=    4  NFV=    5  NFG=    7  F= 0.116836300E-10  G= 0.908E-06  ITERM=  4
NIT=    6  NFV=    7  NFG=   13  F= 0.787821743E-26  G= 0.311E-12  ITERM=  3
NIT=   17  NFV=   40  NFG=   29  F=  60734.8551      G= 0.428E-05  ITERM=  6
NIT=   22  NFV=   25  NFG=   25  F= 0.127726626E-07  G= 0.160E-06  ITERM=  4
NIT=   13  NFV=   15  NFG=   38  F=  2216.45871      G= 0.846E-06  ITERM=  4
NIT=  129  NFV=  147  NFG=  176  F=  191.511336      G= 0.104E-07  ITERM=  4
NIT= 3010  NFV= 3016  NFG= 3012  F= 0.402368464E-24  G= 0.902E-11  ITERM=  3
NIT=  205  NFV=  226  NFG=  236  F=  22287.9069      G= 0.449E-08  ITERM=  4
NIT=  123  NFV=  132  NFG=  152  F=  131234.018      G= 0.743E-09  ITERM=  4
NIT=    7  NFV=    8  NFG=   32  F=  108.517888      G= 0.148E-07  ITERM=  4
NIT=   13  NFV=   20  NFG=   42  F=  18.1763146      G= 0.445E-05  ITERM=  2
NIT=   14  NFV=   15  NFG=   35  F=  2.51109677      G= 0.103E-09  ITERM=  4
NIT=   29  NFV=   34  NFG=   33  F= 0.139780007E-09  G= 0.238E-06  ITERM=  4
NIT=   49  NFV=   53  NFG=   52  F= 0.119511868E-21  G= 0.344E-09  ITERM=  3
NIT=   15  NFV=   16  NFG=   23  F= 0.339085307E-13  G= 0.788E-06  ITERM=  4
NIT=   17  NFV=   18  NFG=   32  F= 0.336618309E-11  G= 0.137E-07  ITERM=  4
NIT=   15  NFV=   18  NFG=   23  F=  647.696136      G= 0.262E-06  ITERM=  4
NIT=   47  NFV=   59  NFG=   98  F=  4486.97024      G= 0.663E-08  ITERM=  4
NITER = 5489    NFVAL = 5629    NITCG = 8282    NSUCC =   22
TIME= 0:00:05.01

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 norm of gradient G and the cause of termination ITERM.
      Subroutine PGACS can be verified and tested using the program
TGACS. This program calls the subroutines TIUB15 (initiation), TAFU15
(function evaluation), TAGU15 (gradient evaluation) containing 21 box
constrained test problems with at most 1000 variables [2]. The results
obtained by the program TGACS on a PC computer with Microsoft Power
Station Fortran compiler have the following form.

NIT= 1028  NFV= 1031  NFG= 1030  F=  0.00000000      G= 0.000E+00  ITERM=  3
NIT=  263  NFV=  262  NFG=  511  F=  1959.28649      G= 0.819E-10  ITERM=  4
NIT=   10  NFV=   12  NFG=   13  F= 0.814133878E-09  G= 0.897E-06  ITERM=  4
NIT=   11  NFV=   14  NFG=   17  F=  134.761343      G= 0.206E-10  ITERM=  4
NIT=    4  NFV=    5  NFG=    7  F= 0.438081882E-11  G= 0.697E-06  ITERM=  4
NIT=    6  NFV=    7  NFG=   13  F= 0.791460667E-17  G= 0.934E-08  ITERM=  3
NIT=   15  NFV=   16  NFG=   42  F=  145814.000      G= 0.000E+00  ITERM=  4
NIT=   17  NFV=   18  NFG=   20  F= 0.201167216E-07  G= 0.162E-06  ITERM=  4
NIT=   54  NFV=   55  NFG=  203  F=  2220.17880      G= 0.614E-10  ITERM=  4
NIT=   95  NFV=  105  NFG=  126  F=  191.511336      G= 0.527E-06  ITERM=  4
NIT= 4577  NFV= 3591  NFG= 3587  F=  0.00000000      G= 0.000E+00  ITERM=  3
NIT=   49  NFV=   50  NFG=   84  F=  67887.2385      G= 0.351E-07  ITERM=  4
NIT=   18  NFV=   19  NFG=   41  F=  147906.000      G= 0.000E+00  ITERM=  4
NIT=    1  NFV=    2  NFG=    6  F=  126.690556      G= 0.000E+00  ITERM=  4
NIT=   33  NFV=   72  NFG=   85  F=  18.1763146      G= 0.182E-04  ITERM=  6
NIT=    8  NFV=   12  NFG=   29  F=  3.59074140      G= 0.542E-06  ITERM=  4
NIT=   25  NFV=   29  NFG=   29  F= 0.716457302E-10  G= 0.922E-07  ITERM=  4
NIT=    0  NFV=    1  NFG=    3  F=  0.00000000      G= 0.000E+00  ITERM=  3
NIT=   28  NFV=   32  NFG=   36  F= 0.209831733E-13  G= 0.620E-06  ITERM=  4
NIT=  937  NFV=  938  NFG= 2806  F=  498.800124      G= 0.572E-12  ITERM=  4
NIT=   21  NFV=   22  NFG=   34  F=  649.598077      G= 0.324E-08  ITERM=  4
NIT=   44  NFV=   51  NFG=   89  F=  4488.96148      G= 0.645E-10  ITERM=  4
NITER = 7244    NFVAL = 6344    NITCG =11206    NSUCC =   22
TIME= 0:00:06.56

References:
-----------

[1] Luksan L., Matonoha C., Vlcek J.: LSA: Algorithms for large-scale
    unconstrained and box constrained optimization Technical Report V-896.
    Prague, ICS AS CR, 2004.

[2] Luksan L., Vlcek J.: Sparse and partially separable test problems
    for unconstrained and equality constrained optimization. Research
    Report V-767, Institute of Computer Science, Academy of Sciences
    of the Czech Republic, Prague, Czech Republic, 1998.

***********************************************************************
*                                                                     *
*   PGAD - HYBRID GAUSS-NEWTON METHOD WITH SECOND-ORDER CORRECTIONS   *
*          AND DIRECT DECOMPOSITION TRUST-REGION SUBALGORITHMS FOR    *
*          LARGE-SCALE PARTIALLY SEPARABLE LEAST SQUARES PROBLEMS.    *
*                                                                     *
***********************************************************************


1. Introduction:
----------------

      The double-precision FORTRAN 77 basic subroutine PGAD is designed
to find a close approximation to a local minimum of a sum of squares

      F(X) =  FA_1(X)**2 + FA_2(X)**2 + ... + FA_NA(X)**2

with simple bounds on variables. Here X is a vector of NF variables and
FA_I(X), 1 <= I <= NA, are twice continuously differentiable functions.
We assume that NF and NA are large, but partial functions FA_I(X),
1 <= I <= NA depend on a small number of variables. This implies that
the mapping AF(X) = [FA_1(X), FA_2(X), ..., FA_NA(X)] has a sparse
Jacobian matrix, which will be denoted by AG(X) (it has NA rows and NF
columns). 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 <= NF. The sparsity pattern of the Jacobian matrix is
stored in the coordinate form if ISPAS=1 or in the standard compressed
row format if ISPAS=2 using arrays IAG and JAG. For example, if the
Jacobian matrix has the following pattern

                AG = | * * 0 * |
                     | * * * 0 |
                     | * 0 0 * |
                     | 0 * * 0 |
                     | * 0 * 0 |

(asterisks denote nonzero elements) then arrays IAG and JAG contain
elements

IAG(1)=1, IAG(2)=1, IAG(3)=1, IAG(4)=2,  IAG(5)=2,  IAG(6)=2,
IAG(7)=3, IAG(8)=3, IAG(9)=4, IAG(10)=4, IAG(11)=5, IAG(12)=5,
JAG(1)=1, JAG(2)=2, JAG(3)=4, JAG(4)=1,  JAG(5)=2,  JAG(6)=3,
JAG(7)=1, JAG(8)=4, JAG(9)=2, JAG(10)=3, JAG(11)=1, JAG(12)=3

if ISPAS=1 or

IAG(1)=1, IAG(2)=4, IAG(3)=7, IAG(4)=9,  IAG(5)=11, IAG(6)=13,
JAG(1)=1, JAG(2)=2, JAG(3)=4, JAG(4)=1,  JAG(5)=2,  JAG(6)=3,
JAG(7)=1, JAG(8)=4, JAG(9)=2, JAG(10)=3, JAG(11)=1, JAG(12)=3

if ISPAS=2. In the first case, nonzero elements can be sorted in an
arbitrary order (not only by rows as in the above example). Arrays
IAG and JAG have to be declared with lengths NA+MA and MA at least,
respectively, where MA is the number of nonzero elements. In the
second case, nonzero elements can be sorted only by rows. Components
of IAG contain total numbers of nonzero elements in all previous
rows increased by 1 and elements of JAG contain corresponding column
indices (note that IAG has NA+1 elements and the last element is
equal to MA+1). Arrays IAG and JAG have to be declared with length
NA+1 and MA at least, respectively.
      To simplify user's work, two additional easy to use subroutines
are added. They call the basic general subroutine PGAD:

      PGADU - unconstrained large-scale optimization,
      PGADS - large-scale optimization with simple bounds.

All subroutines contain a description of formal parameters and
extensive comments. Furthermore, two test programs TGADU and TGADS are
included, which contain several test problems (see e.g. [2]). 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 the method is
given in [1]. 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/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH

The arguments have the following meaning:

 Argument  Type Significance
 ----------------------------------------------------------------------
  NRES      O   Positive INTEGER variable that indicates the number of
                restarts.
  NDEC      O   Positive INTEGER variable that indicates the number of
                matrix decompositions.
  NIN       O   Positive INTEGER variable that indicates the number of
                inner iterations (for solving linear systems).
  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 PGADU, PGADS:
----------------------------

The calling sequences are

      CALL PGADU(NF,NA,MA,X,AF,IAG,JAG,IPAR,RPAR,F,GMAX,IDER,ISPAS,IPRNT,
     & ITERM)
      CALL PGADS(NF,NA,MA,X,IX,XL,XU,AF,IAG,JAG,IPAR,RPAR,F,GMAX,IDER,
     & ISPAS,IPRNT,ITERM)

The arguments have the following meaning.

 Argument  Type Significance
 ----------------------------------------------------------------------
  NF        I   Positive INTEGER variable that specifies the number of
                variables of the partially separable function.
  NA        I   Positive INTEGER variable that specifies the number of
                partial functions.
  MA        I   Number of nonzero elements in the Jacobian matrix. This
                parameter is used as input only if ISPAS=1 (it defines
                dimensions of arrays IAG and JAG in this case).
  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).
  AF(NA)    O   DOUBLE PRECISION vector which contains values of partial
                functions.
  IAG(NA+1) I   INTEGER array which contains pointers of the first
                elements in rows of the Jacobian matrix.
  JAG(MA)   I   INTEGER array which contains column indices of the
                nonzero elements.
  IPAR(7)   I   INTEGER parameters:
                  IPAR(1)=MIT,  IPAR(2)=MFV,  IPAR(3)=MFG,
                  IPAR(4)=MEC,  IPAR(5)=MOS,  IPAR(6)-NONE,
                  IPAR(7)=IFIL.
                Parameters MIT, MFV, MFG, MEC, MOS are described in
                Section 3 together with other parameters of the
                subroutine PGAD. Parameter IFIL specifies a relative
                size of the space reserved for fill-in. The choice
                IFIL=0 causes that the default value IFIL=1 will be
                taken.
  RPAR(9)   I   DOUBLE PRECISION parameters:
                  RPAR(1)=XMAX,  RPAR(2)=TOLX,  RPAR(3)=TOLF,
                  RPAR(4)=TOLB,  RPAR(5)=TOLG,  RPAR(6)=FMIN,
                  RPAR(7)=XDEL,  RPAR(8)=ETA,   RPAR(9)-NONE.
                Parameters XMAX, TOLX, TOLF, TOLB, TOLG, FMIN, XDEL,
                ETA are described in Section 3 together with other
                parameters of the subroutine PGAD.
  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.
  IDER      I   INGEGER variable that specifies the degree of analytically
                computed derivatives (0 OR 1).
  ISPAS     I   INTEGER variable that specifies sparse structure of the
                Jacobian matrix:
                  ISPAS= 1 - the coordinate form is used,
                  ISPAS= 2 - the standard row compresed format is used.
  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.
  ITERM     O   INTEGER variable that indicates the cause of termination:
                  ITERM= 1 - if |X - XO| was less than or equal to TOLX
                             in two subsequent iterations,
                  ITERM= 2 - if |F - FO| was less than or equal to TOLF
                             in two 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= 6 - if termination criterion was not satisfied,
                             but the solution is probably acceptable,
                  ITERM=11 - if NIT exceeded MIT,
                  ITERM=12 - if NFV exceeded MFV,
                  ITERM=13 - if NFG exceeded MFG,
                  ITERM< 0 - if the method failed. Values ITERM<=-40
                             detect a lack of space. In this case,
                             parameter IPAR(7)=IFIL has to be increased
                             (IFIL=2, IFIL=3, etc.).

      The subroutines PGADU, PGADS require the user supplied subroutines
FUN and DFUN that define partial functions and their gradients and have
the form

      SUBROUTINE  FUN(NF,KA,X,FA)
      SUBROUTINE DFUN(NF,KA,X,GA)

If IDER=0, the subroutine DFUN can be empty. The arguments of the 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   INTEGER index of the partial function.
  X(NF)     I   DOUBLE PRECISION an estimate to the solution.
  FA        O   DOUBLE PRECISION value of the KA-th partial function at
                the point X.
  GA(NF)    O   DOUBLE PRECISION gradient of the KA-th partial function
                at the point X. Note that only nonzero elements of this
                gradient have to be assigned.

3. Subroutine PGAD:
-------------------

      This general subroutine is called from all subroutines described
in Section 2. The calling sequence is

      CALL PGAD(NF,NA,NB,MMAX,X,IX,XL,XU,AF,GA,AG,G,HA,AH,H,IH,JH,IAG,
     & JAG,S,XO,GO,AGO,XS,PSL,PERM,INVP,WN11,WN12,WN13,WN14,XMAX,TOLX,
     & TOLF,TOLB,TOLG,FMIN,XDEL,ETA,GMAX,F,MIT,MFV,MFG,MEC,MOS,IDER,
     & IPRNT,ITERM)

The arguments NF, NA, X, IX, XL, XU, AF, IAG, JAG, GMAX, F, IDER, IPRNT,
ITERM have the same meaning as in Section 2. Other arguments have the
following meaning:

 Argument  Type Significance
 ----------------------------------------------------------------------
  NB         I   Nonnegative INTEGER variable that specifies whether the
                 simple bounds are suppressed (NB=0) or accepted (NB>0).
  MMAX       I   INTEGER size of array H.
  GA(NF)     A   DOUBLE PRECISION gradient of the partial function.
  AG(MA)     A   DOUBLE PRECISION nonzero elements of the Jacobian
                 matrix. This array is used only if MEC=3.
  G(NF)      A   DOUBLE PRECISION gradient of the objective function.
  HA(ML)     A   DOUBLE PRECISION Hessian matrix of the partial function.
  AH(MH)     A   DOUBLE PRECISION approximation of the partitioned
                 Hessian matrix.
  H(MMAX)    A   DOUBLE PRECISION nonzero elements of the approximation
                 of the Hessian matrix and nonzero elements of the
                 Choleski factor.
  IH(NF+1)   I   INTEGER array which contains pointers of the diagonal
                 elements in the upper part of the Hessian matrix.
  JH(MMAX)   I   INTEGER array which contains column indices of the
                 nonzero elements and additional working space for the
                 Choleski factor.
  S(NF)      A   DOUBLE PRECISION direction vector.
  XO(NF)     A   DOUBLE PRECISION array which contains increments of
                 variables.
  GO(NF)     A   DOUBLE PRECISION array which contains increments of
                 gradients.
  AGO(MA)    A   DOUBLE PRECISION difference between the current and the
                 old Jacobian matrices. This array is used only if MEC=3.
  XS(NF)     A   DOUBLE PRECISION auxiliary array.
  PSL(NF+1)  A   INTEGER pointer vector in the compact form of the
                 Choleski factor.
  PERM(NF)   A   INTEGER permutation vector.
  INVP(NF)   A   INTEGER inverse permutation vector.
  WN11(NF+1) A   INTEGER auxiliary array.
  WN12(NF+1) A   INTEGER auxiliary array.
  WN13(NF+1) A   INTEGER auxiliary array.
  WN14(NF+1) A   INTEGER auxiliary array.
  XMAX       I   DOUBLE PRECISION maximum stepsize; the choice XMAX=0
                 causes that the default value 1.0D+16 will be taken.
  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-14 will be taken.
  TOLB       I   DOUBLE PRECISION minimum acceptable function value;
                 the choice TOLB=0 causes that the default value
                 TOLB=FMIN+1.0D-16 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.
  FMIN       I   DOUBLE PRECISION lower bound for the minimum function
                 value.
  XDEL       I   DOUBLE PRECISION trust region stepsize; the choice
                 XDEL=0 causes that a suitable default value is
                 computed.
  ETA        I   DOUBLE PRECISION parameter for switch between the
                 Gauss-Newton method and variable metric correction;
                 the choice ETA=0 causes that the default value
                 ETA=1.5D-4 will be taken.
  MIT        I   INTEGER variable that specifies the maximum number of
                 iterations; the choice MIT=0 causes that the default
                 value 5000 will be taken.
  MFV        I   INTEGER variable that specifies the maximum number of
                 function evaluations; the choice MFV=0 causes that
                 the default value 5000 will be taken.
  MFG        I   INTEGER variable that specifies the maximum number of
                 gradient evaluations; the choice MFG=0 causes that
                 the default value 10000 will be taken.
  MEC        I   INTEGER method of a second order correction:
                   MEC=1 - correction by the Marwil sparse variable
                           metric update,
                   MEC=2 - correction by differences of gradients
                           (discrete Newton correction).
                   MEC=3 - correction by the Griewank-Toint partitioned
                           variable metric update (symmetric rank-one).
                           This correction uses three additional
                           matrices (arrays AG, AGO and AH).
                 The choice MEC=0 causes that the default value 2 will
                 be taken.
  MOS        I   INTEGER method for computing trust-region step:
                   MOS=1 - double dog-leg method of Dennis and Mei,
                   MOS=2 - method of More and Sorensen for obtaining
                           optimum locally constrained step.
                 The choice MOS=0 causes that the default value 2 will
                 be taken.

The choice of parameter XMAX can be sensitive in many cases. First, the
objective function can be evaluated only in a relatively small region
(if it contains exponentials) so that the maximum stepsize is necessary.
Secondly, the problem can be very ill-conditioned far from the solution
point so that large steps can be unsuitable. Finally, if the problem has
more local solutions, a suitably chosen maximum stepsize can lead to
obtaining a better local solution.
      The subroutine PGAD requires the user supplied subroutines FUN
and DFUN which are described in Section 2.

4. Verification of the subroutines:
-----------------------------------

      Subroutine PGADU can be verified and tested using the program
TGADU. This program calls the subroutines TIUB15 (initiation), TAFU15
(function evaluation) and TAGU15 (gradient evaluation) containing
22 unconstrained test problems with at most 1000 variables [2]. The
results obtained by the program TGADU on a PC computer with Microsoft
Power Station Fortran compiler have the following form.

NIT= 1377  NFV= 1379  NFG= 1379  F= 0.697391982E-22  G= 0.130E-09  ITERM=  3
NIT=   41  NFV=   46  NFG=   46  F= 0.216572157E-16  G= 0.154E-06  ITERM=  3
NIT=   11  NFV=   12  NFG=   14  F= 0.136731713E-09  G= 0.233E-06  ITERM=  4
NIT=   13  NFV=   16  NFG=   21  F=  134.749772      G= 0.279E-06  ITERM=  4
NIT=    4  NFV=    5  NFG=    7  F= 0.111058357E-10  G= 0.887E-06  ITERM=  4
NIT=    6  NFV=    7  NFG=   13  F= 0.742148235E-26  G= 0.303E-12  ITERM=  3
NIT=   10  NFV=   12  NFG=   23  F=  60734.8551      G= 0.648E-07  ITERM=  4
NIT=   21  NFV=   26  NFG=   24  F= 0.253357740E-08  G= 0.800E-06  ITERM=  4
NIT=   15  NFV=   16  NFG=   36  F=  2216.45871      G= 0.104E-10  ITERM=  4
NIT=   12  NFV=   18  NFG=   21  F=  191.511336      G= 0.524E-07  ITERM=  4
NIT= 2587  NFV= 2593  NFG= 2649  F= 0.647358980E-27  G= 0.359E-12  ITERM=  3
NIT=   16  NFV=   20  NFG=   23  F=  19264.6341      G= 0.513E-10  ITERM=  4
NIT=   17  NFV=   21  NFG=   28  F=  131234.018      G= 0.784E-08  ITERM=  4
NIT=    5  NFV=    8  NFG=   18  F=  108.517888      G= 0.227E-08  ITERM=  4
NIT=    6  NFV=    7  NFG=   15  F=  18.1763146      G= 0.290E-06  ITERM=  4
NIT=   15  NFV=   21  NFG=   40  F=  2.51109677      G= 0.724E-06  ITERM=  4
NIT=   15  NFV=   20  NFG=   19  F= 0.257973699E-16  G= 0.275E-08  ITERM=  3
NIT=   42  NFV=   44  NFG=   45  F= 0.151517993E-24  G= 0.122E-10  ITERM=  3
NIT=   15  NFV=   16  NFG=   23  F= 0.354943701E-14  G= 0.255E-06  ITERM=  4
NIT=   26  NFV=   27  NFG=   29  F= 0.378161520E-10  G= 0.407E-07  ITERM=  4
NIT=   10  NFV=   11  NFG=   17  F=  647.828517      G= 0.773E-11  ITERM=  4
NIT=   26  NFV=   32  NFG=   45  F=  4486.97024      G= 0.602E-07  ITERM=  4
NITER = 4290    NFVAL = 4357    NSUCC =   22
TIME= 0:00:04.56

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 norm of gradient G and the cause of termination ITERM.
      Subroutine PGADS can be verified and tested using the program
TGADS. This program calls the subroutines TIUB15 (initiation), TAFU15
(function evaluation), TAGU15 (gradient evaluation) containing 22 box
constrained test problems with at most 1000 variables [2]. The results
obtained by the program TGADS on a PC computer with Microsoft Power
Station Fortran compiler have the following form.

NIT= 1011  NFV= 1013  NFG= 1013  F=  0.00000000      G= 0.000E+00  ITERM=  3
NIT=  260  NFV=  273  NFG=  508  F=  1959.28649      G= 0.439E-12  ITERM=  4
NIT=   10  NFV=   12  NFG=   13  F= 0.784354965E-09  G= 0.868E-06  ITERM=  4
NIT=   14  NFV=   18  NFG=   19  F=  134.761343      G= 0.827E-08  ITERM=  4
NIT=    4  NFV=    5  NFG=    7  F= 0.438081882E-11  G= 0.697E-06  ITERM=  4
NIT=    6  NFV=    7  NFG=   13  F= 0.791460684E-17  G= 0.934E-08  ITERM=  3
NIT=   22  NFV=   23  NFG=   61  F=  145814.000      G= 0.000E+00  ITERM=  4
NIT=   25  NFV=   32  NFG=   28  F= 0.978141069E-06  G= 0.782E-06  ITERM=  4
NIT=   44  NFV=   45  NFG=  153  F=  2220.17880      G= 0.181E-09  ITERM=  4
NIT=   12  NFV=   19  NFG=   21  F=  191.511336      G= 0.301E-07  ITERM=  4
NIT= 3977  NFV= 2992  NFG= 2990  F=  0.00000000      G= 0.000E+00  ITERM=  3
NIT=   29  NFV=   30  NFG=   50  F=  67887.2385      G= 0.438E-12  ITERM=  4
NIT=   19  NFV=   20  NFG=   36  F=  147906.000      G= 0.000E+00  ITERM=  4
NIT=    1  NFV=    2  NFG=    6  F=  126.690556      G= 0.000E+00  ITERM=  4
NIT=   24  NFV=   27  NFG=   81  F=  18.1763146      G= 0.203E-10  ITERM=  4
NIT=   46  NFV=   50  NFG=  135  F=  3.59074140      G= 0.470E-10  ITERM=  4
NIT=   11  NFV=   12  NFG=   15  F= 0.969524252E-21  G= 0.171E-10  ITERM=  3
NIT=    0  NFV=    1  NFG=    3  F=  0.00000000      G= 0.000E+00  ITERM=  3
NIT=   26  NFV=   30  NFG=   34  F= 0.202602070E-14  G= 0.193E-06  ITERM=  4
NIT=  929  NFV=  930  NFG= 2780  F=  498.800124      G= 0.359E-05  ITERM=  2
NIT=   20  NFV=   21  NFG=   33  F=  649.598077      G= 0.280E-08  ITERM=  4
NIT=   24  NFV=   31  NFG=   55  F=  4488.96148      G= 0.242E-07  ITERM=  4
NITER = 6514    NFVAL = 5593    NSUCC =   22
TIME= 0:00:07.99

References:
-----------

[1] Luksan L., Matonoha C., Vlcek J.: LSA: Algorithms for large-scale
    unconstrained and box constrained optimization Technical Report V-896.
    Prague, ICS AS CR, 2004.

[2] Luksan L., Vlcek J.: Sparse and partially separable test problems
    for unconstrained and equality constrained optimization. Research
    Report V-767, Institute of Computer Science, Academy of Sciences
    of the Czech Republic, Prague, Czech Republic, 1998.

***********************************************************************
*                                                                     *
*         PLIP - A LIMITED MEMORY VARIABLE METRIC ALGORITHM FOR       *
*                LARGE-SCALE OPTIMIZATION.                            *
*                                                                     *
***********************************************************************


1. Introduction:
----------------

      The double-precision FORTRAN 77 basic subroutine PLIP is designed
to find a close approximation to a local minimum of a nonlinear
function F(X) with simple bounds on variables. Here X is a vector of NF
variables and F(X) is a smooth function. We suppose that NF is large
but the sparsity pattern of the Hessian matrix is not known (or the
Hessian matrix is dense). 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 <= NF. To simplify user's work, two additional easy to use
subroutines are added. They call the basic general subroutine PLIP:

      PLIPU - unconstrained large-scale optimization,
      PLIPS - large-scale optimization with simple bounds.

All subroutines contain a description of formal parameters and
extensive comments. Furthermore, two test programs TLIPU and TLIPS are
included, which contain several test problems (see e.g. [2]). 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 the method is
given in [1]. 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/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH

The arguments have the following meaning:

 Argument  Type Significance
 ----------------------------------------------------------------------
  NRES      O   Positive INTEGER variable that indicates the number of
                restarts.
  NDEC      O   Positive INTEGER variable that indicates the number of
                matrix decompositions.
  NIN       O   Positive INTEGER variable that indicates the number of
                inner iterations (for solving linear systems).
  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 PLIPU, PLIPS:
----------------------------

The calling sequences are

      CALL PLIPU(NF,X,IPAR,RPAR,F,GMAX,IPRNT,ITERM)
      CALL PLIPS(NF,X,IX,XL,XU,IPAR,RPAR,F,GMAX,IPRNT,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.
  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).
  IPAR(7)   I   INTEGER parameters:
                  IPAR(1)=MIT,  IPAR(2)=MFV, IPAR(3)-NONE,
                  IPAR(4)=IEST, IPAR(5)-MET, IPAR(6)-NONE,
                  IPAR(7)=MF.
                Parameters MIT, MFV, IEST, MET, MF are described
                in Section 3 together with other parameters of the
                subroutine PLIP.
  RPAR(9)   I   DOUBLE PRECISION parameters:
                  RPAR(1)=XMAX,  RPAR(2)=TOLX,  RPAR(3)=TOLF,
                  RPAR(4)=TOLB,  RPAR(5)=TOLG,  RPAR(6)=FMIN,
                  RPAR(7)-NONE,  RPAR(6)-NONE,  RPAR(9)-NONE.
                Parameters XMAX, TOLX, TOLF, TOLB, TOLG, FMIN are
                described in Section 3 together with other parameters
                of the subroutine PLIP.
  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.
  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.
  ITERM     O   INTEGER variable that indicates the cause of termination:
                  ITERM= 1 - if |X - XO| was less than or equal to TOLX
                             in two subsequent iterations,
                  ITERM= 2 - if |F - FO| was less than or equal to TOLF
                             in two 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= 6 - if termination criterion was not satisfied,
                             but the solution is probably acceptable,
                  ITERM=11 - if NIT exceeded MIT,
                  ITERM=12 - if NFV exceeded MFV,
                  ITERM< 0 - if the method failed.

      The subroutines PLIPU, PLIPS require the user supplied subroutines
OBJ and DOBJ that define the objective function and its gradient and
have the form

      SUBROUTINE  OBJ(NF,X,F)
      SUBROUTINE DOBJ(NF,X,G)

The arguments of the 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 gradient of the objective function
                at the point X.


3. Subroutine PLIP:
-------------------

      This general subroutine is called from all subroutines described
in Section 2. The calling sequence is

      CALL PLIP(NF,NB,X,IX,XL,XU,GF,S,XO,GO,SO,XM,XR,GR,XMAX,TOLX,TOLF,
     & TOLB,TOLG,FMIN,GMAX,F,MIT,MFV,IEST,MET,MF,IPRNT,ITERM)

The arguments NF, NB, X, IX, XL, XU, GMAX, F, IPRNT, ITERM, have the
same meaning as in Section 2. Other arguments have the following meaning:

 Argument  Type Significance
 ----------------------------------------------------------------------
  GF(NF)    A   DOUBLE PRECISION gradient of the objective function.
  S(NF)     A   DOUBLE PRECISION direction vector.
  XO(NF)    A   DOUBLE PRECISION array which contains increments of
                variables.
  GO(NF)    A   DOUBLE PRECISION array which contains increments of
                gradients.
  SO(NF)    A   DOUBLE PRECISION auxiliary array.
  XM(NF*MF) A   DOUBLE PRECISION array which contains columns
                of the updated matrix stored in the product form.
  XR(MF)    A   DOUBLE PRECISION array which contains reduced
                increments of variables.
  GR(MF)    A   DOUBLE PRECISION array which contains reduced
                increments of gradients.
  XMAX      I   DOUBLE PRECISION maximum stepsize; the choice XMAX=0
                causes that the default value 1.0D+16 will be taken.
  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-14 will be taken.
  TOLB      I   DOUBLE PRECISION minimum acceptable function value;
                the choice TOLB=0 causes that the default value
                TOLB=FMIN+1.0D-16 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.
  FMIN      I   DOUBLE PRECISION lower bound for the minimum function
                value.
  MIT       I   INTEGER variable that specifies the maximum number of
                iterations; the choice MIT=0 causes that the default
                value 9000 will be taken.
  MFV       I   INTEGER variable that specifies the maximum number of
                function evaluations; the choice MFV=0 causes that
                the default value 9000 will be taken.
  IEST      I   INTEGER estimation of the minimum functiom value for
                the line search:
                  IEST=0 - estimation is not used,
                  IEST=1 - lower bound FMIN is used as an estimation
                           for the minimum function value.
  MET       I   INTEGER variable that specifies the limited-memory
                method:
                  MET=1 - rank-one method,
                  MET=2 - rank-two method.
                The choice MET=0 causes that the default value MET=2
                will be taken.
  MF        I   The number of limited-memory variable metric updates
                in each iteration (they use MF stored vectors).

The choice of parameter XMAX can be sensitive in many cases. First, the
objective function can be evaluated only in a relatively small region
(if it contains exponentials) so that the maximum stepsize is necessary.
Secondly, the problem can be very ill-conditioned far from the solution
point so that large steps can be unsuitable. Finally, if the problem has
more local solutions, a suitably chosen maximum stepsize can lead to
obtaining a better local solution.
      The subroutine PLIP requires the user supplied subroutines OBJ
and DOBJ which are described in Section 2.

4. Verification of the subroutines:
-----------------------------------

      Subroutine PLIPU can be verified and tested using the program
TLIPU. This program calls the subroutines TIUD14 (initiation), TFFU14
(function evaluation) and TFGU14 (gradient evaluation) containing
22 unconstrained test problems with at most 1000 variables [2]. The
results obtained by the program TLIPU on a PC computer with Microsoft
Power Station Fortran compiler have the following form.

NIT= 5383  NFV= 5417  NFG= 5417  F= 0.601022658E-13  G= 0.599E-06  ITERM=  4
NIT=  530  NFV=  557  NFG=  557  F=  3.57276719      G= 0.124E-05  ITERM=  2
NIT=  125  NFV=  128  NFG=  128  F= 0.338270284E-12  G= 0.518E-06  ITERM=  4
NIT=  109  NFV=  114  NFG=  114  F=  269.499543      G= 0.669E-06  ITERM=  4
NIT=   26  NFV=   27  NFG=   27  F= 0.710072396E-11  G= 0.951E-06  ITERM=  4
NIT=   35  NFV=   36  NFG=   36  F= 0.142942272E-10  G= 0.737E-06  ITERM=  4
NIT=   36  NFV=   41  NFG=   41  F=  336.937181      G= 0.956E-06  ITERM=  4
NIT=   33  NFV=   36  NFG=   36  F=  761774.954      G= 0.192E-02  ITERM=  2
NIT=   15  NFV=   18  NFG=   18  F=  316.436141      G= 0.264E-06  ITERM=  4
NIT= 2003  NFV= 2030  NFG= 2030  F= -124.950000      G= 0.116E-04  ITERM=  2
NIT=  157  NFV=  175  NFG=  175  F=  10.7765879      G= 0.299E-06  ITERM=  4
NIT=  337  NFV=  350  NFG=  350  F=  982.273617      G= 0.145E-04  ITERM=  2
NIT=    9  NFV=   10  NFG=   10  F= 0.230414406E-14  G= 0.642E-07  ITERM=  4
NIT=    8  NFV=   10  NFG=   10  F= 0.128834241E-08  G= 0.977E-06  ITERM=  4
NIT= 1226  NFV= 1256  NFG= 1256  F=  1.92401599      G= 0.970E-06  ITERM=  4
NIT=  237  NFV=  246  NFG=  246  F= -427.404476      G= 0.501E-04  ITERM=  2
NIT=  598  NFV=  604  NFG=  604  F=-0.379921091E-01  G= 0.908E-06  ITERM=  4
NIT=  989  NFV=  998  NFG=  998  F=-0.245741193E-01  G= 0.975E-06  ITERM=  4
NIT= 1261  NFV= 1272  NFG= 1272  F=  59.5986241      G= 0.410E-05  ITERM=  2
NIT= 2045  NFV= 2058  NFG= 2058  F= -1.00013520      G= 0.911E-06  ITERM=  4
NIT= 2175  NFV= 2196  NFG= 2196  F=  2.13866377      G= 0.996E-06  ITERM=  4
NIT= 1261  NFV= 1292  NFG= 1292  F=  1.00000000      G= 0.927E-06  ITERM=  4
NITER =18598    NFVAL =18871    NSUCC =   22
TIME= 0:00:10.63

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 norm of gradient G and the cause of termination ITERM.
      Subroutine PLIPS can be verified and tested using the program
TLIPS. This program calls the subroutines TIUD14 (initiation), TFFU14
(function evaluation), TFGU14 (gradient evaluation) containing 22 box
constrained test problems with at most 1000 variables [2]. The results
obtained by the program TLIPS on a PC computer with Microsoft Power
Station Fortran compiler have the following form.

NIT= 5263  NFV= 5321  NFG= 5321  F= 0.530131995E-13  G= 0.370E-05  ITERM=  2
NIT= 2293  NFV= 2447  NFG= 2447  F=  3930.43962      G= 0.251E-04  ITERM=  2
NIT=  127  NFV=  132  NFG=  132  F= 0.210550150E-12  G= 0.437E-06  ITERM=  4
NIT=   70  NFV=   72  NFG=   72  F=  269.522686      G= 0.794E-06  ITERM=  4
NIT=   26  NFV=   27  NFG=   27  F= 0.710072396E-11  G= 0.951E-06  ITERM=  4
NIT=   35  NFV=   36  NFG=   36  F= 0.142942272E-10  G= 0.737E-06  ITERM=  4
NIT=   37  NFV=   43  NFG=   43  F=  336.937181      G= 0.133E-05  ITERM=  2
NIT=   59  NFV=   65  NFG=   65  F=  761925.725      G= 0.399E-03  ITERM=  2
NIT=  508  NFV=  510  NFG=  510  F=  428.056916      G= 0.776E-06  ITERM=  4
NIT= 1253  NFV= 1277  NFG= 1277  F= -82.5400568      G= 0.120E-04  ITERM=  2
NIT=   13  NFV=   19  NFG=   19  F=  96517.2947      G= 0.150E-04  ITERM=  2
NIT=   95  NFV=  102  NFG=  102  F=  4994.21410      G= 0.790E-04  ITERM=  2
NIT=    9  NFV=   10  NFG=   10  F= 0.230414406E-14  G= 0.642E-07  ITERM=  4
NIT=    8  NFV=   10  NFG=   10  F= 0.128834241E-08  G= 0.977E-06  ITERM=  4
NIT= 1226  NFV= 1256  NFG= 1256  F=  1.92401599      G= 0.970E-06  ITERM=  4
NIT=  227  NFV=  228  NFG=  228  F= -427.391653      G= 0.952E-05  ITERM=  2
NIT=  598  NFV=  604  NFG=  604  F=-0.379921091E-01  G= 0.908E-06  ITERM=  4
NIT=  989  NFV=  998  NFG=  998  F=-0.245741193E-01  G= 0.975E-06  ITERM=  4
NIT= 1367  NFV= 1383  NFG= 1383  F=  1654.94525      G= 0.105E-04  ITERM=  2
NIT= 2274  NFV= 2303  NFG= 2303  F= -1.00013520      G= 0.798E-06  ITERM=  4
NIT= 1196  NFV= 1211  NFG= 1211  F=  2.41354873      G= 0.975E-06  ITERM=  4
NIT= 1361  NFV= 1381  NFG= 1381  F=  1.00000000      G= 0.962E-06  ITERM=  4
NITER =19034    NFVAL =19435    NSUCC =   22
TIME= 0:00:11.09

References:
-----------

[1] Luksan L., Matonoha C., Vlcek J.: LSA: Algorithms for large-scale
    unconstrained and box constrained optimization Technical Report V-896.
    Prague, ICS AS CR, 2004.

[2] Luksan L., Vlcek J.: Sparse and partially separable test problems
    for unconstrained and equality constrained optimization. Research
    Report V-767, Institute of Computer Science, Academy of Sciences
    of the Czech Republic, Prague, Czech Republic, 1998.
***********************************************************************
*                                                                     *
*         PLIS - A LIMITED MEMORY VARIABLE METRIC ALGORITHM FOR       *
*                LARGE-SCALE OPTIMIZATION.                            *
*                                                                     *
***********************************************************************


1. Introduction:
----------------

      The double-precision FORTRAN 77 basic subroutine PLIS is designed
to find a close approximation to a local minimum of a nonlinear
function F(X) with simple bounds on variables. Here X is a vector of NF
variables and F(X) is a smooth function. We suppose that NF is large
but the sparsity pattern of the Hessian matrix is not known (or the
Hessian matrix is dense). 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 <= NF. To simplify user's work, two additional easy to use
subroutines are added. They call the basic general subroutine PLIS:

      PLISU - unconstrained large-scale optimization,
      PLISS - large-scale optimization with simple bounds.

All subroutines contain a description of formal parameters and
extensive comments. Furthermore, two test programs TLISU and TLISS are
included, which contain several test problems (see e.g. [2]). 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 the method is
given in [1]. 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/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH

The arguments have the following meaning:

 Argument  Type Significance
 ----------------------------------------------------------------------
  NRES      O   Positive INTEGER variable that indicates the number of
                restarts.
  NDEC      O   Positive INTEGER variable that indicates the number of
                matrix decompositions.
  NIN       O   Positive INTEGER variable that indicates the number of
                inner iterations (for solving linear systems).
  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 PLISU, PLISS:
----------------------------

The calling sequences are

      CALL PLISU(NF,X,IPAR,RPAR,F,GMAX,IPRNT,ITERM)
      CALL PLISS(NF,X,IX,XL,XU,IPAR,RPAR,F,GMAX,IPRNT,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.
  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).
  IPAR(7)   I   INTEGER parameters:
                  IPAR(1)=MIT,  IPAR(2)=MFV,  IPAR(3)-NONE,
                  IPAR(4)=IEST, IPAR(5)-NONE, IPAR(6)-NONE,
                  IPAR(7)=MF.
                Parameters MIT, MFV, IEST, MF are described in Section 3
                together with other parameters of the subroutine PLIS.
  RPAR(9)   I   DOUBLE PRECISION parameters:
                  RPAR(1)=XMAX,  RPAR(2)=TOLX,  RPAR(3)=TOLF,
                  RPAR(4)=TOLB,  RPAR(5)=TOLG,  RPAR(6)=FMIN,
                  RPAR(7)-NONE,  RPAR(6)-NONE,  RPAR(9)-NONE.
                Parameters XMAX, TOLX, TOLF, TOLB, TOLG, FMIN are
                described in Section 3 together with other parameters
                of the subroutine PLIS.
  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.
  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.
  ITERM     O   INTEGER variable that indicates the cause of termination:
                  ITERM= 1 - if |X - XO| was less than or equal to TOLX
                             in two subsequent iterations,
                  ITERM= 2 - if |F - FO| was less than or equal to TOLF
                             in two 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= 6 - if termination criterion was not satisfied,
                             but the solution is probably acceptable,
                  ITERM=11 - if NIT exceeded MIT,
                  ITERM=12 - if NFV exceeded MFV,
                  ITERM< 0 - if the method failed.

      The subroutines PLISU, PLISS require the user supplied subroutines
OBJ and DOBJ that define the objective function and its gradient and
have the form

      SUBROUTINE  OBJ(NF,X,F)
      SUBROUTINE DOBJ(NF,X,G)

The arguments of the 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 gradient of the objective function
                at the point X.


3. Subroutine PLIS:
-------------------

      This general subroutine is called from all subroutines described
in Section 2. The calling sequence is

      CALL PLIS(NF,NB,X,IX,XL,XU,GF,S,XO,GO,UO,VO,XMAX,TOLX,TOLF,TOLB,
     & TOLG,FMIN,GMAX,F,MIT,MFV,IEST,MF,IPRNT,ITERM)

The arguments NF, NB, X, IX, XL, XU, GMAX, F, IPRNT, ITERM, have the
same meaning as in Section 2. Other arguments have the following meaning:

 Argument  Type Significance
 ----------------------------------------------------------------------
  GF(NF)    A   DOUBLE PRECISION gradient of the objective function.
  S(NF)     A   DOUBLE PRECISION direction vector.
  XO(NF*MF) A   DOUBLE PRECISION array which contains increments of
                variables.
  GO(NF*MF) A   DOUBLE PRECISION array which contains increments of
                gradients.
  UO(MF)    A   DOUBLE PRECISION Auxiliary array.
  VO(MF)    A   DOUBLE PRECISION Auxiliary array.
  XMAX      I   DOUBLE PRECISION maximum stepsize; the choice XMAX=0
                causes that the default value 1.0D+16 will be taken.
  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-14 will be taken.
  TOLB      I   DOUBLE PRECISION minimum acceptable function value;
                the choice TOLB=0 causes that the default value
                TOLB=FMIN+1.0D-16 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.
  FMIN      I   DOUBLE PRECISION lower bound for the minimum function
                value.
  MIT       I   INTEGER variable that specifies the maximum number of
                iterations; the choice MIT=0 causes that the default
                value 9000 will be taken.
  MFV       I   INTEGER variable that specifies the maximum number of
                function evaluations; the choice MFV=0 causes that
                the default value 9000 will be taken.
  IEST      I   INTEGER estimation of the minimum functiom value for
                the line search:
                  IEST=0 - estimation is not used,
                  IEST=1 - lower bound FMIN is used as an estimation
                           for the minimum function value.
  MF        I   The number of limited-memory variable metric updates
                in each iteration (they use 2*MF stored vectors).

The choice of parameter XMAX can be sensitive in many cases. First, the
objective function can be evaluated only in a relatively small region
(if it contains exponentials) so that the maximum stepsize is necessary.
Secondly, the problem can be very ill-conditioned far from the solution
point so that large steps can be unsuitable. Finally, if the problem has
more local solutions, a suitably chosen maximum stepsize can lead to
obtaining a better local solution.
      The subroutine PLIS requires the user supplied subroutines OBJ
and DOBJ which are described in Section 2.

4. Verification of the subroutines:
-----------------------------------

      Subroutine PLISU can be verified and tested using the program
TLISU. This program calls the subroutines TIUD14 (initiation), TFFU14
(function evaluation) and TFGU14 (gradient evaluation) containing
22 unconstrained test problems with at most 1000 variables [2]. The
results obtained by the program TLISU on a PC computer with Microsoft
Power Station Fortran compiler have the following form.

NIT= 4988  NFV= 5554  NFG= 5554  F= 0.963780013E-14  G= 0.891E-06  ITERM=  4
NIT=  425  NFV=  454  NFG=  454  F=  14.9944763      G= 0.773E-05  ITERM=  2
NIT=   74  NFV=   78  NFG=   78  F= 0.655101686E-09  G= 0.539E-06  ITERM=  4
NIT=  103  NFV=  112  NFG=  112  F=  269.499543      G= 0.899E-06  ITERM=  4
NIT=   24  NFV=   26  NFG=   26  F= 0.130639280E-11  G= 0.671E-06  ITERM=  4
NIT=   30  NFV=   31  NFG=   31  F= 0.216102227E-10  G= 0.946E-06  ITERM=  4
NIT=   38  NFV=   43  NFG=   43  F=  335.137433      G= 0.730E-06  ITERM=  4
NIT=   29  NFV=   33  NFG=   33  F=  761774.954      G= 0.432E-03  ITERM=  2
NIT=   13  NFV=   16  NFG=   16  F=  316.436141      G= 0.369E-06  ITERM=  4
NIT= 1540  NFV= 1582  NFG= 1582  F= -124.630000      G= 0.124E-04  ITERM=  2
NIT=  114  NFV=  138  NFG=  138  F=  10.7765879      G= 0.380E-06  ITERM=  4
NIT=  248  NFV=  267  NFG=  267  F=  982.273617      G= 0.123E-04  ITERM=  2
NIT=    7  NFV=    8  NFG=    8  F= 0.165734137E-12  G= 0.453E-06  ITERM=  4
NIT=   10  NFV=   12  NFG=   12  F= 0.128729169E-08  G= 0.916E-06  ITERM=  4
NIT= 2830  NFV= 2929  NFG= 2929  F=  1.92401599      G= 0.936E-06  ITERM=  4
NIT=  196  NFV=  210  NFG=  210  F= -427.404476      G= 0.991E-05  ITERM=  2
NIT= 1007  NFV= 1032  NFG= 1032  F=-0.379921091E-01  G= 0.876E-06  ITERM=  4
NIT= 1449  NFV= 1474  NFG= 1474  F=-0.245741193E-01  G= 0.862E-06  ITERM=  4
NIT= 1393  NFV= 1431  NFG= 1431  F=  59.5986241      G= 0.259E-05  ITERM=  2
NIT= 2129  NFV= 2191  NFG= 2191  F= -1.00013520      G= 0.908E-06  ITERM=  4
NIT= 2120  NFV= 2169  NFG= 2169  F=  2.13866377      G= 0.927E-06  ITERM=  4
NIT= 1305  NFV= 1346  NFG= 1346  F=  1.00000000      G= 0.982E-06  ITERM=  4
NITER =20072    NFVAL =21136    NSUCC =   22
TIME= 0:00:10.78

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 norm of gradient G and the cause of termination ITERM.
      Subroutine PLISS can be verified and tested using the program
TLISS. This program calls the subroutines TIUD14 (initiation), TFFU14
(function evaluation), TFGU14 (gradient evaluation) containing 22 box
constrained test problems with at most 1000 variables [2]. The results
obtained by the program TLISS on a PC computer with Microsoft Power
Station Fortran compiler have the following form.

NIT= 5063  NFV= 5738  NFG= 5738  F=  0.00000000      G= 0.000E+00  ITERM=  3
NIT= 3167  NFV= 4664  NFG= 4664  F=  3926.45961      G= 0.626E-04  ITERM=  2
NIT=  113  NFV=  124  NFG=  124  F= 0.459503394E-12  G= 0.600E-06  ITERM=  4
NIT=   59  NFV=   64  NFG=   64  F=  269.522686      G= 0.838E-06  ITERM=  4
NIT=   24  NFV=   26  NFG=   26  F= 0.130639280E-11  G= 0.671E-06  ITERM=  4
NIT=   30  NFV=   31  NFG=   31  F= 0.216102227E-10  G= 0.946E-06  ITERM=  4
NIT=   33  NFV=   40  NFG=   40  F=  337.722479      G= 0.592E-06  ITERM=  4
NIT=   50  NFV=   55  NFG=   55  F=  761925.725      G= 0.240E-03  ITERM=  2
NIT=  505  NFV=  508  NFG=  508  F=  428.056916      G= 0.334E-07  ITERM=  4
NIT= 1167  NFV= 1227  NFG= 1227  F= -81.0913589      G= 0.100E-04  ITERM=  2
NIT=   20  NFV=   26  NFG=   26  F=  96517.2947      G= 0.745E-05  ITERM=  2
NIT=   91  NFV=  109  NFG=  109  F=  4994.21410      G= 0.104E-04  ITERM=  2
NIT=    7  NFV=    8  NFG=    8  F= 0.165734137E-12  G= 0.453E-06  ITERM=  4
NIT=   10  NFV=   12  NFG=   12  F= 0.128729169E-08  G= 0.916E-06  ITERM=  4
NIT= 2830  NFV= 2929  NFG= 2929  F=  1.92401599      G= 0.936E-06  ITERM=  4
NIT=  178  NFV=  184  NFG=  184  F= -427.391653      G= 0.107E-04  ITERM=  2
NIT= 1007  NFV= 1032  NFG= 1032  F=-0.379921091E-01  G= 0.876E-06  ITERM=  4
NIT= 1449  NFV= 1474  NFG= 1474  F=-0.245741193E-01  G= 0.862E-06  ITERM=  4
NIT= 1561  NFV= 1595  NFG= 1595  F=  1654.94525      G= 0.112E-04  ITERM=  2
NIT= 2075  NFV= 2121  NFG= 2121  F= -1.00013520      G= 0.916E-06  ITERM=  4
NIT= 1361  NFV= 1389  NFG= 1389  F=  2.41354873      G= 0.709E-06  ITERM=  4
NIT= 1562  NFV= 1598  NFG= 1598  F=  1.00000000      G= 0.786E-06  ITERM=  4
NITER =22362    NFVAL =24954    NSUCC =   22
TIME= 0:00:12.39

References:
-----------

[1] Luksan L., Matonoha C., Vlcek J.: LSA: Algorithms for large-scale
    unconstrained and box constrained optimization Technical Report V-896.
    Prague, ICS AS CR, 2004.

[2] Luksan L., Vlcek J.: Sparse and partially separable test problems
    for unconstrained and equality constrained optimization. Research
    Report V-767, Institute of Computer Science, Academy of Sciences
    of the Czech Republic, Prague, Czech Republic, 1998.
***********************************************************************
*                                                                     *
* PMAX - A PRIMAL INTERIOR-POINT VARIABLE METRIC AND DISCRETE NEWTON  *
*        METHODS WITH DIRECT DECOMPOSITION LINE-SEARCH SUBALGORITHM   *
*        FOR LARGE-SCALE MINIMAX OPTIMIZATION.                        *
*                                                                     *
***********************************************************************


1. Introduction:
----------------

      The double-precision FORTRAN 77 basic subroutine PMAX is designed
to find a close approximation to a local minimum of a special nonsmooth
objectine function, which has the form

      F(X) =  MAX(FA_1(X), FA_2(X), ..., FA_NA(X)),

if IEXT<0, or

      F(X) =  MAX(|FA_1(X)|, |FA_2(X)|, ..., |FA_NA(X)|),

if IEXT=0, or

      F(X) =  MAX(-FA_1(X), -FA_2(X), ..., -FA_NA(X)),

if IEXT>0. Here X is a vector of NF variables and FA_I(X), 1<=I<=NA,
are twice continuously differentiable functions. We assume that
NF and NA are large, but partial functions FA_I(X), 1<=I<=NA,
depend on a small number of variables.  This implies that the mapping
AF(X) = [FA_1(X), FA_2(X), ..., FA_NA(X)] has a sparse Jacobian
matrix, which will be denoted by AG(X) (it has NA rows and NF columns).
The sparsity pattern of the Jacobian matrix is stored in the coordinate
form if ISPAS=1 or in the standard compressed row format if ISPAS=2
using arrays IAG and JAG. For example, if the Jacobian matrix has the
following pattern

                AG = | * * 0 * |
                     | * * * 0 |
                     | * 0 0 * |
                     | 0 * * 0 |
                     | * 0 * 0 |

(asterisks denote nonzero elements) then arrays IAG and JAG contain
elements

IAG(1)=1, IAG(2)=1, IAG(3)=1, IAG(4)=2,  IAG(5)=2,  IAG(6)=2,
IAG(7)=3, IAG(8)=3, IAG(9)=4, IAG(10)=4, IAG(11)=5, IAG(12)=5,
JAG(1)=1, JAG(2)=2, JAG(3)=4, JAG(4)=1,  JAG(5)=2,  JAG(6)=3,
JAG(7)=1, JAG(8)=4, JAG(9)=2, JAG(10)=3, JAG(11)=1, JAG(12)=3

if ISPAS=1 or

IAG(1)=1, IAG(2)=4, IAG(3)=7, IAG(4)=9,  IAG(5)=11, IAG(6)=13,
JAG(1)=1, JAG(2)=2, JAG(3)=4, JAG(4)=1,  JAG(5)=2,  JAG(6)=3,
JAG(7)=1, JAG(8)=4, JAG(9)=2, JAG(10)=3, JAG(11)=1, JAG(12)=3

if ISPAS=2. In the first case, nonzero elements can be sorted in an
arbitrary order (not only by rows as in the above example). Arrays
IAG and JAG have to be declared with lengths NA+MA and MA at least,
respectively, where MA is the number of nonzero elements. In the
second case, nonzero elements can be sorted only by rows. Components
of IAG contain total numbers of nonzero elements in all previous
rows increased by 1 and elements of JAG contain corresponding column
indices (note that IAG has NA+1 elements and the last element is
equal to MA+1). Arrays IAG and JAG have to be declared with length
NA+1 and MA at least, respectively.
      To simplify user's work, an additional easy to use subroutine
PMAXU is added. It calls the basic general subroutine PMAX. All
subroutines contain a description of formal parameters and extensive
comments. Furthermore, test program TMAXU is included, which contains
several test problems (see e.g. [2]). This test program serves as an
example for using the subroutine PMAXU, verifies its correctness and
demonstrates its efficiency.
      In this short guide, we describe all subroutines which can be
called from the user's program. A detailed description of the method is
given in [1]. 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/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH

The arguments have the following meaning:

 Argument  Type Significance
 ----------------------------------------------------------------------
  NRES      O   Positive INTEGER variable that indicates the number of
                restarts.
  NDEC      O   Positive INTEGER variable that indicates the number of
                matrix decompositions.
  NIN       O   Positive INTEGER variable that indicates the number of
                inner iterations (for solving linear systems).
  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. Subroutine PMAXU:
--------------------

The calling sequence is

      CALL PMAXU(NF,NA,MA,X,AF,IAG,JAG,IPAR,RPAR,F,GMAX,IEXT,ISPAS,IPRNT,
     & ITERM)

The arguments have the following meaning.

 Argument  Type Significance
 ----------------------------------------------------------------------
  NF        I   Positive INTEGER variable that specifies the number of
                variables of the minimax objective function.
  NA        I   Positive INTEGER variable that specifies the number of
                partial functions.
  MA        I   Number of nonzero elements in the Jacobian matrix. This
                parameter is used as input only if ISPAS=1 (it defines
                dimensions of arrays IAG and JAG in this case).
  X(NF)     U   On input, DOUBLE PRECISION vector with the initial
                estimate to the solution. On output, the approximation
                to the minimum.
  AF(NA)    O   DOUBLE PRECISION vector which contains values of partial
                functions.
  IAG(NA+1) I   INTEGER array which contains pointers of the first
                elements in rows of the Jacobian matrix.
  JAG(MA)   I   INTEGER array which contains column indices of the
                nonzero elements.
  IPAR(7)   I   INTEGER parameters:
                  IPAR(1)=MIT,  IPAR(2)=MFV,  IPAR(3)=MFG,
                  IPAR(4)=IEST, IPAR(5)=MED,  IPAR(6)-NONE,
                  IPAR(7)=IFIL.
                Parameters MIT, MFV, MFG, IEST, MED are described in
                Section 3 together with other parameters of the subroutine
                PMAX. Parameter IFIL specifies a relative size of the
                space reserved for fill-in. The choice IFIL=0 causes that
                the default value IFIL=1 will be taken.
  RPAR(9)   I   DOUBLE PRECISION parameters:
                  RPAR(1)=XMAX,  RPAR(2)=TOLX,  RPAR(3)=TOLF,
                  RPAR(4)=TOLB,  RPAR(5)=TOLG,  RPAR(6)=FMIN,
                  RPAR(7)-NONE,  RPAR(6)=ETA4,  RPAR(9)=ETA5.
                Parameters XMAX, TOLX, TOLF, TOLB, TOLG, FMIN, ETA4,
                ETA5 are described in Section 3 together with other
                parameters of the subroutine PMAX.
  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 type of minimax:
                  IEXT< 0 - minimization of the maximum positive value.
                  IEXT= 0 - minimization of the maximum absolute value.
                  IEXT> 0 - minimization of the maximum negative value.
  ISPAS     I   INTEGER variable that specifies sparse structure of the
                Jacobian matrix:
                  ISPAS= 1 - the coordinate form is used,
                  ISPAS= 2 - the standard row compresed format is used.
  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.
  ITERM     O   INTEGER variable that indicates the cause of termination:
                  ITERM= 1 - if |X - XO| was less than or equal to TOLX
                             in two subsequent iterations,
                  ITERM= 2 - if |F - FO| was less than or equal to TOLF
                             in two 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= 6 - if termination criterion was not satisfied,
                             but the solution is probably acceptable,
                  ITERM=11 - if NIT exceeded MIT,
                  ITERM=12 - if NFV exceeded MFV,
                  ITERM=13 - if NFG exceeded MFG,
                  ITERM< 0 - if the method failed. Values ITERM<=-40
                             detect a lack of space. In this case,
                             parameter IPAR(7)=IFIL has to be increased
                             (IFIL=2, IFIL=3, etc.).

      The subroutine PMAXU requires the user supplied subroutines FUN and
DFUN that define partial functions and their gradients and have the form

      SUBROUTINE  FUN(NF,KA,X,FA)
      SUBROUTINE DFUN(NF,KA,X,GA)

The arguments of the 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   INTEGER index of the partial function.
  X(NF)     I   DOUBLE PRECISION an estimate to the solution.
  FA        O   DOUBLE PRECISION value of the KA-th partial function at
                the point X.
  GA(NF)    O   DOUBLE PRECISION gradient of the KA-th partial function
                at the point X. Note that only nonzero elements of this
                gradient have to be assigned.


3. Subroutine PMAX:
-------------------

      This general subroutine is called from all subroutines described
in Section 2. The calling sequence is

      CALL PMAX(NF,NA,MMAX,X,IX,AF,AFO,AG,AGO,GA,AH,AZL,AZU,G,H,IH,JH,
     & IA,IAG,JAG,S,XO,GO,GS,GP,COL,PSL,PERM,INVP,WN11,WN12,WN13,WN14,
     & XMAX,TOLX,TOLF,TOLB,TOLG,FMIN,ETA4,ETA5,GMAX,F,MIT,MFV,MFG,IEST,
     & MED,IEXT,IPRNT,ITERM)

The arguments NF, NA, X, AF, IAG, JAG, GMAX, F, IEXT, IPRNT, ITERM have
the same meaning as in Section 2. Other arguments have the following
meaning:

 Argument  Type Significance
 ----------------------------------------------------------------------
  MMAX       I   INTEGER size of array H.
  IX(NF)     A   INTEGER auxiliary array.
  AFO(NA)    A   DOUBLE PRECISION auxiliary array.
  AG(MA)     A   DOUBLE PRECISION nonzero elements of the Jacobian
                 matrix
  AGO(MA)    A   DOUBLE PRECISION difference between the current and the
                 old Jacobian matrices. This array is used only if MED=1.
  GA(NF)     A   DOUBLE PRECISION gradient of the partial function.
  AH(MH)     A   DOUBLE PRECISION approximation of the partitioned
                 Hessian matrix. This array is used only if MED=1.
  AZL(NA)    A   DOUBLE PRECISION lower Lagrange multipliers.
  AZU(NA)    A   DOUBLE PRECISION upper Lagrange multipliers.
  G(NF)      A   DOUBLE PRECISION gradient of the objective function.
  H(MMAX)    A   DOUBLE PRECISION nonzero elements of the approximation
                 of the Hessian matrix and nonzero elements of the
                 Choleski factor.
  IH(NF+1)   I   INTEGER array which contains pointers of the diagonal
                 elements in the upper part of the Hessian matrix.
  JH(MMAX)   I   INTEGER array which contains column indices of the
                 nonzero elements and additional working space for the
                 Choleski factor.
  IA(NA)     A   INTEGER auxiliary array.
  S(NF)      A   DOUBLE PRECISION direction vector.
  XO(NF)     A   DOUBLE PRECISION array which contains increments of
                 variables.
  GO(NF)     A   DOUBLE PRECISION array which contains increments of
                 gradients.
  GS(NF)     A   DOUBLE PRECISION auxiliary array.
  GP(NF)     A   DOUBLE PRECISION auxiliary array.
  COL(NF)    A   INTEGER auxiliary array.
  PSL(NF+1)  A   INTEGER pointer vector in the compact form of the
                 Choleski factor.
  PERM(NF)   A   INTEGER permutation vector.
  INVP(NF)   A   INTEGER inverse permutation vector.
  WN11(NF+1) A   INTEGER auxiliary array.
  WN12(NF+1) A   INTEGER auxiliary array.
  WN13(NF+1) A   INTEGER auxiliary array.
  WN14(NF+1) A   INTEGER auxiliary array.
  XMAX       I   DOUBLE PRECISION maximum stepsize; the choice XMAX=0
                 causes that the default value 1.0D+16 will be taken.
  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-14 will be taken.
  TOLB       I   DOUBLE PRECISION minimum acceptable function value;
                 the choice TOLB=0 causes that the default value
                 TOLB=FMIN+1.0D-16 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.
  FMIN       I   DOUBLE PRECISION lower bound for the minimum function
                 value.
  ETA4       I   DOUBLE PRECISION coefficient for the barrier parameter
                 decrease; the choice ETA4=0 causes that the default
                 value ETA5=8.5D-1 will be taken.
  ETA5       I   DOUBLE PRECISION minimum permitted value of the barrier
                 parameter; the choice ETA5=0 causes that the default
                 value ETA5=1.0D-10 will be taken.
  MIT        I   INTEGER variable that specifies the maximum number of
                 iterations; the choice MIT=0 causes that the default
                 value 9000 will be taken.
  MFV        I   INTEGER variable that specifies the maximum number of
                 function evaluations; the choice MFV=0 causes that
                 the default value 9000 will be taken.
  MFG        I   INTEGER variable that specifies the maximum number of
                 gradient evaluations; the choice MFG=0 causes that
                 the default value 10000 will be taken.
  IEST       I   INTEGER estimation of the minimum functiom value for
                 the line search:
                   IEST=0 - estimation is not used,
                   IEST=1 - lower bound FMIN is used as an estimation
                            for the minimum function value.
  MED        I   INTEGER variable that specifies the method used.
                   MED=1 - partitioned variable metric method,
                   MED=2 - safeguarded discrete Newton method.

The choice of parameter XMAX can be sensitive in many cases. First, the
objective function can be evaluated only in a relatively small region
(if it contains exponentials) so that the maximum stepsize is necessary.
Secondly, the problem can be very ill-conditioned far from the solution
point so that large steps can be unsuitable. Finally, if the problem has
more local solutions, a suitably chosen maximum stepsize can lead to
obtaining a better local solution. A suitable choice of parameter ETA5
(larger than 1.0d-8) can sometimes improve the efficiency of the method.
      The subroutine PMAX requires the user supplied subroutines FUN
and DFUN which are described in Section 2.

4. Verification of the subroutines:
-----------------------------------

      Subroutine PMAXU can be verified and tested using the program
TMAXU. This program calls the subroutines TIUB14 (initiation), TAFU14
(function evaluation) and TAGU14 (gradient evaluation) containing
22 unconstrained test problems with at most 200 variables [2]. The
results obtained by the program TMAXU on a PC computer with Microsoft
Power Station Fortran compiler have the following form.

NIT=   53  NFV=   66  NFG=   54  F= 0.260681654E-14  G= 0.120E-07  ITERM=  4
NIT=  107  NFV=  160  NFG=  108  F= 0.502441303E-12  G= 0.262E-06  ITERM=  4
NIT=   33  NFV=   41  NFG=   34  F= 0.535439934E-08  G= 0.814E-06  ITERM=  4
NIT=   51  NFV=   93  NFG=   52  F= 0.540217976      G= 0.383E-06  ITERM=  4
NIT=   23  NFV=   24  NFG=   24  F= 0.132910215E-08  G= 0.482E-06  ITERM=  4
NIT=   46  NFV=   52  NFG=   47  F= 0.216701250E-08  G= 0.436E-06  ITERM=  4
NIT=   48  NFV=  113  NFG=   49  F= 0.260162540      G= 0.430E-06  ITERM=  4
NIT=   21  NFV=   58  NFG=   22  F=  282.380956      G= 0.806E-06  ITERM=  4
NIT=   59  NFV=  146  NFG=   60  F= 0.185849706      G= 0.287E-06  ITERM=  4
NIT=  159  NFV=  215  NFG=  160  F=-0.251638288      G= 0.250E-06  ITERM=  4
NIT=   70  NFV=   96  NFG=   71  F= 0.538829394E-01  G= 0.139E-07  ITERM=  4
NIT=  136  NFV=  245  NFG=  137  F= 0.941962422      G= 0.207E-06  ITERM=  4
NIT=    2  NFV=    4  NFG=    3  F= 0.456380111E-19  G= 0.304E-11  ITERM=  3
NIT=    5  NFV=    6  NFG=    6  F= 0.162409086E-08  G= 0.671E-06  ITERM=  4
NIT=  116  NFV=  120  NFG=  117  F= 0.199003538E-01  G= 0.436E-06  ITERM=  4
NIT=  110  NFV=  214  NFG=  111  F=-0.388943896E-02  G= 0.518E-05  ITERM=  2
NIT=   33  NFV=   49  NFG=   34  F=-0.110417781E-06  G= 0.764E-06  ITERM=  4
NIT=   62  NFV=   77  NFG=   63  F= 0.744234285E-09  G= 0.611E-07  ITERM=  4
NIT=    9  NFV=   23  NFG=   10  F=  42.6746811      G= 0.373E-09  ITERM=  4
NIT=   25  NFV=   32  NFG=   26  F=-0.497512435E-02  G= 0.422E-06  ITERM=  4
NIT=   16  NFV=   23  NFG=   17  F= 0.298487756E-01  G= 0.595E-06  ITERM=  4
NIT=   32  NFV=   82  NFG=   33  F= 0.577532726E-02  G= 0.972E-07  ITERM=  4
NITER = 1216    NFVAL = 1939    NSUCC =   22
TIME= 0:00:00.75

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 norm of gradient G and the cause of termination ITERM.

References:
-----------

[1] Luksan L., Matonoha C., Vlcek J.: LSA: Algorithms for large-scale
    unconstrained and box constrained optimization Technical Report V-896.
    Prague, ICS AS CR, 2004.

[2] Luksan L., Vlcek J.: Sparse and partially separable test problems
    for unconstrained and equality constrained optimization. Research
    Report V-767, Institute of Computer Science, Academy of Sciences
    of the Czech Republic, Prague, Czech Republic, 1998.

***********************************************************************
*                                                                     *
*    PNEC - A DISCRETE NEWTON METHOD WITH ITERATIVE CG-BASED          *
*           TRUST-REGION SUBALGORITHMS FOR LARGE-SCALE OPTIMIZATION   *
*           PROBLEMS WITH SPARSE HESSIAN MATRICES.                    *
*                                                                     *
***********************************************************************


1. Introduction:
----------------

      The double-precision FORTRAN 77 basic subroutine PNEC is designed
to find a close approximation to a local minimum of a nonlinear
function F(X) with simple bounds on variables. Here X is a vector of NF
variables and F(X) is a smooth function. We suppose that NF is large
and the sparsity pattern of the Hessian matrix is known. 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 <= NF. The sparsity pattern of the Hessian matrix (only
the upper part) is stored in the coordinate form if ISPAS=1 or in the
standard compressed row format if ISPAS=2 using arrays IH and JH. For
example, if the Jacobian matrix has the following pattern

                H = | * * * 0 * |
                    | * * 0 * 0 |
                    | * 0 * 0 * |
                    | 0 * 0 * 0 |
                    | * 0 * 0 * |

(asterisks denote nonzero elements) then arrays IH and JH contain
elements

IH(1)=1, IH(2)=1, IH(3)=1, IH(4)=1, IH(5)=2, IH(6)=2, IH(7)=3,
IH(8)=3, IH(9)=4, IH(10)=5,
JH(1)=1, JH(2)=2, JH(3)=3, JH(4)=5, JH(5)=2, JH(6)=4, JH(7)=3,
JH(8)=5, JH(9)=4, JH(10)=5

if ISPAS=1 or

IH(1)=1, IH(2)=5, IH(3)=7, IH(4)=9, IH(5)=10, IH(6)=11,
JH(1)=1, JH(2)=2, JH(3)=3, JH(4)=5, JH(5)=2, JH(6)=4, JH(7)=3,
JH(8)=5, JH(9)=4, JH(10)=5

if ISPAS=2. In the first case, nonzero elements in the upper part of
the Hessian matrix can be sorted in an arbitrary order (not only by
rows as in the above example) and arrays IH and JH have to be declared
with lengths NF+MH at least, where MH is the number of nonzero elements.
In the second case, nonzero elements can be sorted only by rows.
Components of IH contain addresses of the diagonal elements in this
sequence and components of JH contain corresponding column indices
(note that IH has NF+1 elements and the last element is equal to MH+1).
Arrays IH and JH have to be declared with lengths NF+1 and MH at least,
respectively.
      To simplify user's work, two additional easy to use subroutines
are added. They call the basic general subroutine PNEC:

      PNECU - unconstrained large-scale optimization,
      PNECS - large-scale optimization with simple bounds.

All subroutines contain a description of formal parameters and
extensive comments. Furthermore, two test programs TNECU and TNECS are
included, which contain several test problems (see e.g. [2]). 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 the method is
given in [1]. 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/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH

The arguments have the following meaning:

 Argument  Type Significance
 ----------------------------------------------------------------------
  NRES      O   Positive INTEGER variable that indicates the number of
                restarts.
  NDEC      O   Positive INTEGER variable that indicates the number of
                matrix decompositions.
  NIN       O   Positive INTEGER variable that indicates the number of
                inner iterations (for solving linear systems).
  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 PNECU, PNECS:
----------------------------

The calling sequences are

      CALL PNECU(NF,MH,X,IH,JH,IPAR,RPAR,F,GMAX,ISPAS,IPRNT,ITERM)
      CALL PNECS(NF,MH,X,IX,XL,XU,IH,JH,IPAR,RPAR,F,GMAX,ISPAS,IPRNT,
     & 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.
  MH        I   Number of nonzero elements in the upper part of the
                Hessian matrix. This parameter is used as input only if
                ISPAS=1 (it defines dimensions of arrays IH and JH in
                this case).
  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).
  IH(NF+1)  I   INTEGER array which contains pointers of the diagonal
                elements in the upper part of the Hessian matrix.
  JH(MH)    I   INTEGER array which contains column indices of the
                nonzero elements and additional working space for the
                Choleski factor.
  IPAR(7)   I   INTEGER parameters:
                  IPAR(1)=MIT,  IPAR(2)=MFV,  IPAR(3)=MFG,
                  IPAR(4)=IEST, IPAR(5)=MOS1, IPAR(6)=MOS2,
                  IPAR(7)=IFIL.
                Parameters MIT, MFV, MFG, IEST, MOS1, MOS2 are
                described in Section 3 together with other parameters
                of the subroutine PNEC. Parameter IFIL specifies a
                relative size of the space reserved for fill-in. The
                choice IFIL=0 causes that the default value IFIL=1 will
                be taken.
  RPAR(9)   I   DOUBLE PRECISION parameters:
                  RPAR(1)=XMAX,  RPAR(2)=TOLX,  RPAR(3)=TOLF,
                  RPAR(4)=TOLB,  RPAR(5)=TOLG,  RPAR(6)=FMIN,
                  RPAR(7)=XDEL,  RPAR(8)-NONE,  RPAR(9)-NONE.
                Parameters XMAX, TOLX, TOLF, TOLB, TOLG, FMIN, XDEL
                are described in Section 3 together with other
                parameters of the subroutine PNEC.
  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.
  ISPAS     I   INTEGER variable that specifies sparse structure of the
                Hessian matrix:
                  ISPAS= 1 - the coordinate form is used,
                  ISPAS= 2 - the standard row compresed format is used.
  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.
  ITERM     O   INTEGER variable that indicates the cause of termination:
                  ITERM= 1 - if |X - XO| was less than or equal to TOLX
                             in two subsequent iterations,
                  ITERM= 2 - if |F - FO| was less than or equal to TOLF
                             in two 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= 6 - if termination criterion was not satisfied,
                             but the solution is probably acceptable,
                  ITERM=11 - if NIT exceeded MIT,
                  ITERM=12 - if NFV exceeded MFV,
                  ITERM=13 - if NFG exceeded MFG,
                  ITERM< 0 - if the method failed. Values ITERM<=-40
                             detect a lack of space. In this case,
                             parameter IPAR(7)=IFIL has to be increased
                             (IFIL=2, IFIL=3, etc.).

      The subroutines PNECU, PNECS require the user supplied subroutines
OBJ and DOBJ that define the objective function and its gradient and have
the form

      SUBROUTINE  OBJ(NF,X,F)
      SUBROUTINE DOBJ(NF,X,G)

The arguments of the 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 gradient of the objective function
                at the point X.


3. Subroutine PNEC:
-------------------

      This general subroutine is called from all subroutines described
in Section 2. The calling sequence is

      CALL PNEC(NF,NB,MMAX,X,IX,XL,XU,GF,HF,IH,JH,S,XO,GO,XS,GS,COL,
     & WN11,WN12,IW,XMAX,TOLX,TOLF,TOLB,TOLG,FMIN,XDEL,GMAX,F,MIT,MFV,
     & MFG,IEST,MOS1,MOS2,IPRNT,ITERM)

The arguments NF, NB, X, IX, XL, XU, IH, JH, GMAX, F, IPRNT, ITERM,
have the same meaning as in Section 2. Other arguments have the following
meaning:

 Argument  Type Significance
 ----------------------------------------------------------------------
  MMAX       I   INTEGER size of array H.
  GF(NF)     A   DOUBLE PRECISION gradient of the objective function.
  HF(MMAX)   A   DOUBLE PRECISION nonzero elements of the original
                 Hessian matrix and nonzero elements of the Choleski
                 factor.
  S(NF)      A   DOUBLE PRECISION direction vector.
  XO(NF)     A   DOUBLE PRECISION array which contains increments of
                 variables.
  GO(NF)     A   DOUBLE PRECISION array which contains increments of
                 gradients.
  XS(NF)     A   DOUBLE PRECISION auxiliary array.
  GS(NF)     A   DOUBLE PRECISION auxiliary array.
  COL(NF)    A   INTEGER auxiliary array.
  WN11(NF+1) A   INTEGER auxiliary array.
  WN12(NF+1) A   INTEGER auxiliary array.
  IW(NF+1)   A   INTEGER auxiliary array.
  XMAX       I   DOUBLE PRECISION maximum stepsize; the choice XMAX=0
                 causes that the default value 1.0D+16 will be taken.
  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-14 will be taken.
  TOLB      I   DOUBLE PRECISION minimum acceptable function value;
                the choice TOLB=0 causes that the default value
                TOLB=FMIN+1.0D-16 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.
  FMIN      I   DOUBLE PRECISION lower bound for the minimum function
                value.
  XDEL      I   DOUBLE PRECISION trust region stepsize; the choice
                XDEL=0 causes that a suitable default value is
                computed.
  MIT       I   INTEGER variable that specifies the maximum number of
                iterations; the choice MIT=0 causes that the default
                value 5000 will be taken.
  MFV       I   INTEGER variable that specifies the maximum number of
                function evaluations; the choice MFV=0 causes that
                the default value 5000 will be taken.
  MFG       I   INTEGER variable that specifies the maximum number of
                gradient evaluations; the choice MFG=0 causes that
                the default value 10000 will be taken.
  IEST      I   INTEGER estimation of the minimum functiom value for
                the line search:
                  IEST=0 - estimation is not used,
                  IEST=1 - lower bound FMIN is used as an estimation
                           for the minimum function value.
  MOS1      I   INTEGER number of Lanczos steps for determination of
                the Levenberg-Marquardt parameter (recommended value
                is MOS1=5).
  MOS2      I   INTEGER choice of preconditioning strategy:
                  MOS2=1 - preconditioning is not used,
                  MOS2=2 - preconditioning by the incomplete
                            Gill-Murray decomposition,
                  MOS2=3 - preconditioning by the incomplete
                            Gill-Murray decomposition combined with
                            preliminary solution of the preconditioned
                            system.

The choice of parameter XMAX can be sensitive in many cases. First, the
objective function can be evaluated only in a relatively small region
(if it contains exponentials) so that the maximum stepsize is necessary.
Secondly, the problem can be very ill-conditioned far from the solution
point so that large steps can be unsuitable. Finally, if the problem has
more local solutions, a suitably chosen maximum stepsize can lead to
obtaining a better local solution.
      The subroutine PNEC requires the user supplied subroutines OBJ
and DOBJ which are described in Section 2.

4. Verification of the subroutines:
-----------------------------------

      Subroutine PNECU can be verified and tested using the program
TNECU. This program calls the subroutines TIUS14 (initiation), TFFU14
(function evaluation) and TFGU14 (gradient evaluation) containing
22 unconstrained test problems with at most 1000 variables [2]. The
results obtained by the program TNECU on a PC computer with Microsoft
Power Station Fortran compiler have the following form.

NIT= 1447  NFV= 1450  NFG= 5792  F= 0.173249493E-16  G= 0.138E-06  ITERM=  3
NIT=   79  NFV=   89  NFG=  400  F= 0.169144088E-20  G= 0.382E-09  ITERM=  3
NIT=   18  NFV=   19  NFG=  114  F= 0.180692317E-09  G= 0.316E-06  ITERM=  4
NIT=   24  NFV=   25  NFG=  100  F=  269.499543      G= 0.136E-08  ITERM=  4
NIT=   11  NFV=   12  NFG=   72  F= 0.990922474E-10  G= 0.511E-06  ITERM=  4
NIT=   17  NFV=   21  NFG=  252  F= 0.166904871E-10  G= 0.898E-06  ITERM=  4
NIT=   11  NFV=   12  NFG=   72  F=  336.937181      G= 0.629E-06  ITERM=  4
NIT=    6  NFV=   11  NFG=  126  F=  761774.954      G= 0.237E-05  ITERM=  2
NIT=    7  NFV=    8  NFG=   16  F=  316.436141      G= 0.362E-08  ITERM=  4
NIT=   70  NFV=   74  NFG=  639  F= -133.630000      G= 0.221E-07  ITERM=  4
NIT=   71  NFV=   72  NFG=  432  F=  10.7765879      G= 0.237E-10  ITERM=  4
NIT=  133  NFV=  134  NFG=  536  F=  982.273617      G= 0.203E-07  ITERM=  4
NIT=    7  NFV=    8  NFG=   32  F= 0.402530175E-26  G= 0.153E-13  ITERM=  3
NIT=    2  NFV=    3  NFG=   18  F= 0.129028794E-08  G= 0.820E-06  ITERM=  4
NIT=   10  NFV=   11  NFG=   44  F=  1.92401599      G= 0.217E-06  ITERM=  4
NIT=   12  NFV=   15  NFG=   78  F= -427.404476      G= 0.894E-09  ITERM=  4
NIT=    8  NFV=    9  NFG=   54  F=-0.379921091E-01  G= 0.391E-09  ITERM=  4
NIT=    8  NFV=    9  NFG=   54  F=-0.245741193E-01  G= 0.705E-10  ITERM=  4
NIT=    7  NFV=    8  NFG=   48  F=  59.5986241      G= 0.106E-08  ITERM=  4
NIT=   10  NFV=   11  NFG=   66  F= -1.00013520      G= 0.277E-11  ITERM=  4
NIT=   11  NFV=   12  NFG=   72  F=  2.13866377      G= 0.154E-06  ITERM=  4
NIT=   46  NFV=   51  NFG=  282  F=  1.00000000      G= 0.376E-08  ITERM=  4
NITER = 2015    NFVAL = 2064    NITCG = 1182    NSUCC =   22
TIME= 0:00:02.92

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 norm of gradient G and the cause of termination ITERM.
      Subroutine PNECS can be verified and tested using the program
TNECS. This program calls the subroutines TIUS14 (initiation), TFFU14
(function evaluation), TFGU14 (gradient evaluation) containing 22 box
constrained test problems with at most 1000 variables [2]. The results
obtained by the program TNECS on a PC computer with Microsoft Power
Station Fortran compiler have the following form.

NIT= 1436  NFV= 1439  NFG= 5748  F=  3.98662385      G= 0.138E-08  ITERM=  4
NIT=   79  NFV=   89  NFG=  400  F= 0.169144088E-20  G= 0.382E-09  ITERM=  3
NIT=   18  NFV=   19  NFG=  114  F= 0.180692317E-09  G= 0.316E-06  ITERM=  4
NIT=   24  NFV=   25  NFG=  100  F=  269.499543      G= 0.136E-08  ITERM=  4
NIT=   11  NFV=   12  NFG=   72  F= 0.990922474E-10  G= 0.511E-06  ITERM=  4
NIT=   17  NFV=   21  NFG=  252  F= 0.166904871E-10  G= 0.898E-06  ITERM=  4
NIT=   11  NFV=   12  NFG=   72  F=  336.937181      G= 0.629E-06  ITERM=  4
NIT=    6  NFV=   11  NFG=  126  F=  761774.954      G= 0.237E-05  ITERM=  2
NIT=    7  NFV=    8  NFG=   16  F=  316.436141      G= 0.362E-08  ITERM=  4
NIT=   70  NFV=   74  NFG=  639  F= -133.630000      G= 0.221E-07  ITERM=  4
NIT=   27  NFV=   31  NFG=  168  F=  86.8673060      G= 0.416E-06  ITERM=  4
NIT=  133  NFV=  134  NFG=  536  F=  982.273617      G= 0.203E-07  ITERM=  4
NIT=    7  NFV=    8  NFG=   32  F= 0.402530175E-26  G= 0.153E-13  ITERM=  3
NIT=    2  NFV=    3  NFG=   18  F= 0.129028794E-08  G= 0.820E-06  ITERM=  4
NIT=   10  NFV=   11  NFG=   44  F=  1.92401599      G= 0.217E-06  ITERM=  4
NIT=   12  NFV=   15  NFG=   78  F= -427.404476      G= 0.894E-09  ITERM=  4
NIT=    8  NFV=    9  NFG=   54  F=-0.379921091E-01  G= 0.391E-09  ITERM=  4
NIT=    8  NFV=    9  NFG=   54  F=-0.245741193E-01  G= 0.705E-10  ITERM=  4
NIT=    7  NFV=    8  NFG=   48  F=  59.5986241      G= 0.106E-08  ITERM=  4
NIT=   10  NFV=   11  NFG=   66  F= -1.00013520      G= 0.277E-11  ITERM=  4
NIT=   11  NFV=   12  NFG=   72  F=  2.13866377      G= 0.154E-06  ITERM=  4
NIT=   46  NFV=   51  NFG=  282  F=  1.00000000      G= 0.376E-08  ITERM=  4
NITER = 1960    NFVAL = 2012    NITCG = 1127    NSUCC =   22
TIME= 0:00:02.88

References:
-----------

[1] Luksan L., Matonoha C., Vlcek J.: LSA: Algorithms for large-scale
    unconstrained and box constrained optimization Technical Report V-896.
    Prague, ICS AS CR, 2004.

[2] Luksan L., Vlcek J.: Sparse and partially separable test problems
    for unconstrained and equality constrained optimization. Research
    Report V-767, Institute of Computer Science, Academy of Sciences
    of the Czech Republic, Prague, Czech Republic, 1998.

***********************************************************************
*                                                                     *
*    PNED - A DISCRETE NEWTON METHOD WITH DIRECT DECOMPOSITION        *
*           TRUST-REGION SUBALGORITHMS FOR LARGE-SCALE OPTIMIZATION   *
*           PROBLEMS WITH SPARSE HESSIAN MATRICES.                    *
*                                                                     *
***********************************************************************


1. Introduction:
----------------

      The double-precision FORTRAN 77 basic subroutine PNED is designed
to find a close approximation to a local minimum of a nonlinear
function F(X) with simple bounds on variables. Here X is a vector of NF
variables and F(X) is a smooth function. We suppose that NF is large
and the sparsity pattern of the Hessian matrix is known. 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 <= NF. The sparsity pattern of the Hessian matrix (only
the upper part) is stored in the coordinate form if ISPAS=1 or in the
standard compressed row format if ISPAS=2 using arrays IH and JH. For
example, if the Jacobian matrix has the following pattern

                H = | * * * 0 * |
                    | * * 0 * 0 |
                    | * 0 * 0 * |
                    | 0 * 0 * 0 |
                    | * 0 * 0 * |

(asterisks denote nonzero elements) then arrays IH and JH contain
elements

IH(1)=1, IH(2)=1, IH(3)=1, IH(4)=1, IH(5)=2, IH(6)=2, IH(7)=3,
IH(8)=3, IH(9)=4, IH(10)=5,
JH(1)=1, JH(2)=2, JH(3)=3, JH(4)=5, JH(5)=2, JH(6)=4, JH(7)=3,
JH(8)=5, JH(9)=4, JH(10)=5

if ISPAS=1 or

IH(1)=1, IH(2)=5, IH(3)=7, IH(4)=9, IH(5)=10, IH(6)=11,
JH(1)=1, JH(2)=2, JH(3)=3, JH(4)=5, JH(5)=2, JH(6)=4, JH(7)=3,
JH(8)=5, JH(9)=4, JH(10)=5

if ISPAS=2. In the first case, nonzero elements in the upper part of
the Hessian matrix can be sorted in an arbitrary order (not only by
rows as in the above example) and arrays IH and JH have to be declared
with lengths NF+MH at least, where MH is the number of nonzero elements.
In the second case, nonzero elements can be sorted only by rows.
Components of IH contain addresses of the diagonal elements in this
sequence and components of JH contain corresponding column indices
(note that IH has NF+1 elements and the last element is equal to MH+1).
Arrays IH and JH have to be declared with lengths NF+1 and MH at least,
respectively.
      To simplify user's work, two additional easy to use subroutines
are added. They call the basic general subroutine PNED:

      PNEDU - unconstrained large-scale optimization,
      PNEDS - large-scale optimization with simple bounds.

All subroutines contain a description of formal parameters and
extensive comments. Furthermore, two test programs TNEDU and TNEDS are
included, which contain several test problems (see e.g. [2]). 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 the method is
given in [1]. 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/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH

The arguments have the following meaning:

 Argument  Type Significance
 ----------------------------------------------------------------------
  NRES      O   Positive INTEGER variable that indicates the number of
                restarts.
  NDEC      O   Positive INTEGER variable that indicates the number of
                matrix decompositions.
  NIN       O   Positive INTEGER variable that indicates the number of
                inner iterations (for solving linear systems).
  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 PNEDU, PNEDS:
----------------------------

The calling sequences are

      CALL PNEDU(NF,MH,X,IH,JH,IPAR,RPAR,F,GMAX,ISPAS,IPRNT,ITERM)
      CALL PNEDS(NF,MH,X,IX,XL,XU,IH,JH,IPAR,RPAR,F,GMAX,ISPAS,IPRNT,
     & 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.
  MH        I   Number of nonzero elements in the upper part of the
                Hessian matrix. This parameter is used as input only if
                ISPAS=1 (it defines dimensions of arrays IH and JH in
                this case).
  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).
  IH(NF+1)  I   INTEGER array which contains pointers of the diagonal
                elements in the upper part of the Hessian matrix.
  JH(MH)    I   INTEGER array which contains column indices of the
                nonzero elements and additional working space for the
                Choleski factor.
  IPAR(7)   I   INTEGER parameters:
                  IPAR(1)=MIT,  IPAR(2)=MFV,  IPAR(3)=MFG,
                  IPAR(4)=IEST, IPAR(5)=MOS, IPAR(6)-NONE,
                  IPAR(7)=IFIL.
                Parameters MIT, MFV, MFG, IEST, MOS are described in
                Section 3 together with other parameters of the
                subroutine PNED. Parameter IFIL specifies a relative
                size of the space reserved for fill-in. The choice
                IFIL=0 causes that the default value IFIL=1 will be
                taken.
  RPAR(9)   I   DOUBLE PRECISION parameters:
                  RPAR(1)=XMAX,  RPAR(2)=TOLX,  RPAR(3)=TOLF,
                  RPAR(4)=TOLB,  RPAR(5)=TOLG,  RPAR(6)=FMIN,
                  RPAR(7)=XDEL,  RPAR(8)-NONE,  RPAR(9)-NONE.
                Parameters XMAX, TOLX, TOLF, TOLB, TOLG, FMIN, XDEL
                are described in Section 3 together with other
                parameters of the subroutine PNED.
  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.
  ISPAS     I   INTEGER variable that specifies sparse structure of the
                Hessian matrix:
                  ISPAS= 1 - the coordinate form is used,
                  ISPAS= 2 - the standard row compresed format is used.
  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.
  ITERM     O   INTEGER variable that indicates the cause of termination:
                  ITERM= 1 - if |X - XO| was less than or equal to TOLX
                             in two subsequent iterations,
                  ITERM= 2 - if |F - FO| was less than or equal to TOLF
                             in two 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= 6 - if termination criterion was not satisfied,
                             but the solution is probably acceptable,
                  ITERM=11 - if NIT exceeded MIT,
                  ITERM=12 - if NFV exceeded MFV,
                  ITERM=13 - if NFG exceeded MFG,
                  ITERM< 0 - if the method failed. Values ITERM<=-40
                             detect a lack of space. In this case,
                             parameter IPAR(7)=IFIL has to be increased
                             (IFIL=2, IFIL=3, etc.).

      The subroutines PNEDU, PNEDS require the user supplied subroutines
OBJ and DOBJ that define the objective function and its gradient and have
the form

      SUBROUTINE  OBJ(NF,X,F)
      SUBROUTINE DOBJ(NF,X,G)

The arguments of the 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 gradient of the objective function
                at the point X.


3. Subroutine PNED:
-------------------

      This general subroutine is called from all subroutines described
in Section 2. The calling sequence is

      CALL PNED(NF,NB,MMAX,X,IX,XL,XU,GF,HF,IH,JH,S,XO,GO,XS,COL,PSL,
     & PERM,INVP,WN11,WN12,WN13,WN14,XMAX,TOLX,TOLF,TOLB,TOLG,FMIN,
     & XDEL,GMAX,F,MIT,MFV,MFG,IEST,MOS,IPRNT,ITERM)

The arguments NF, NB, X, IX, XL, XU, IH, JH, GMAX, F, IPRNT, ITERM,
have the same meaning as in Section 2. Other arguments have the following
meaning:

 Argument  Type Significance
 ----------------------------------------------------------------------
  MMAX       I   INTEGER size of array H.
  GF(NF)     A   DOUBLE PRECISION gradient of the objective function.
  HF(MMAX)   A   DOUBLE PRECISION nonzero elements of the original
                 Hessian matrix and nonzero elements of the Choleski
                 factor.
  S(NF)      A   DOUBLE PRECISION direction vector.
  XO(NF)     A   DOUBLE PRECISION array which contains increments of
                 variables.
  GO(NF)     A   DOUBLE PRECISION array which contains increments of
                 gradients.
  XS(NF)     A   DOUBLE PRECISION auxiliary array.
  COL(NF)    A   INTEGER auxiliary array.
  PSL(NF+1)  A   INTEGER pointer vector in the compact form of the
                 Choleski factor.
  PERM(NF)   A   INTEGER permutation vector.
  INVP(NF)   A   INTEGER inverse permutation vector.
  WN11(NF+1) A   INTEGER auxiliary array.
  WN12(NF+1) A   INTEGER auxiliary array.
  WN13(NF+1) A   INTEGER auxiliary array.
  WN14(NF+1) A   INTEGER auxiliary array.
  XMAX       I   DOUBLE PRECISION maximum stepsize; the choice XMAX=0
                 causes that the default value 1.0D+16 will be taken.
  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-14 will be taken.
  TOLB       I   DOUBLE PRECISION minimum acceptable function value;
                 the choice TOLB=0 causes that the default value
                 TOLB=FMIN+1.0D-16 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.
  FMIN       I   DOUBLE PRECISION lower bound for the minimum function
                 value.
  XDEL       I   DOUBLE PRECISION trust region stepsize; the choice
                 XDEL=0 causes that a suitable default value is
                 computed.
  MIT        I   INTEGER variable that specifies the maximum number of
                 iterations; the choice MIT=0 causes that the default
                 value 5000 will be taken.
  MFV        I   INTEGER variable that specifies the maximum number of
                 function evaluations; the choice MFV=0 causes that
                 the default value 5000 will be taken.
  MFG        I   INTEGER variable that specifies the maximum number of
                 gradient evaluations; the choice MFG=0 causes that
                 the default value 10000 will be taken.
  IEST       I   INTEGER estimation of the minimum functiom value for
                 the line search:
                   IEST=0 - estimation is not used,
                   IEST=1 - lower bound FMIN is used as an estimation
                            for the minimum function value.
  MOS        I   INTEGER method for computing trust-region step:
                   MOS=1 - double dog-leg method of Dennis and Mei,
                   MOS=2 - method of More and Sorensen for obtaining
                           optimum locally constrained step.
                 The choice MOS=0 causes that the default value 2 will
                 be taken.

The choice of parameter XMAX can be sensitive in many cases. First, the
objective function can be evaluated only in a relatively small region
(if it contains exponentials) so that the maximum stepsize is necessary.
Secondly, the problem can be very ill-conditioned far from the solution
point so that large steps can be unsuitable. Finally, if the problem has
more local solutions, a suitably chosen maximum stepsize can lead to
obtaining a better local solution.
      The subroutine PNED requires the user supplied subroutines OBJ
and DOBJ which are described in Section 2.

4. Verification of the subroutines:
-----------------------------------

      Subroutine PNEDU can be verified and tested using the program
TNEDU. This program calls the subroutines TIUS14 (initiation), TFFU14
(function evaluation) and TFGU14 (gradient evaluation) containing
22 unconstrained test problems with at most 1000 variables [2]. The
results obtained by the program TNEDU on a PC computer with Microsoft
Power Station Fortran compiler have the following form.

NIT= 1421  NFV= 1425  NFG= 5688  F= 0.465831486E-25  G= 0.418E-12  ITERM=  3
NIT=   39  NFV=   45  NFG=  200  F= 0.231406390E-14  G= 0.350E-06  ITERM=  4
NIT=   17  NFV=   18  NFG=  108  F= 0.839782900E-09  G= 0.933E-06  ITERM=  4
NIT=   24  NFV=   25  NFG=  100  F=  269.499543      G= 0.666E-10  ITERM=  4
NIT=   11  NFV=   12  NFG=   72  F= 0.795109456E-10  G= 0.473E-06  ITERM=  4
NIT=   13  NFV=   16  NFG=  196  F= 0.125944855E-10  G= 0.815E-06  ITERM=  4
NIT=   12  NFV=   13  NFG=   78  F=  336.937181      G= 0.300E-06  ITERM=  4
NIT=    4  NFV=    5  NFG=   90  F=  761774.954      G= 0.216E-06  ITERM=  4
NIT=    7  NFV=    9  NFG=   16  F=  316.436141      G= 0.146E-06  ITERM=  4
NIT=   69  NFV=   75  NFG=  630  F= -135.290000      G= 0.291E-11  ITERM=  4
NIT=   67  NFV=   68  NFG=  408  F=  10.7765879      G= 0.199E-06  ITERM=  4
NIT=  127  NFV=  128  NFG=  512  F=  982.273617      G= 0.495E-09  ITERM=  4
NIT=    6  NFV=    7  NFG=   28  F= 0.598998674E-10  G= 0.693E-06  ITERM=  4
NIT=    2  NFV=    3  NFG=   18  F= 0.129013604E-08  G= 0.792E-06  ITERM=  4
NIT=    9  NFV=   10  NFG=   40  F=  1.92401599      G= 0.414E-06  ITERM=  4
NIT=    7  NFV=    8  NFG=   48  F= -427.404476      G= 0.565E-07  ITERM=  4
NIT=    8  NFV=    9  NFG=   54  F=-0.379921091E-01  G= 0.314E-10  ITERM=  4
NIT=    7  NFV=    8  NFG=   48  F=-0.245741193E-01  G= 0.218E-09  ITERM=  4
NIT=    6  NFV=    7  NFG=   42  F=  59.5986241      G= 0.952E-08  ITERM=  4
NIT=   14  NFV=   15  NFG=   90  F= -1.00013520      G= 0.139E-08  ITERM=  4
NIT=   11  NFV=   12  NFG=   72  F=  2.13866377      G= 0.331E-08  ITERM=  4
NIT=   30  NFV=   34  NFG=  186  F=  1.00000000      G= 0.164E-08  ITERM=  4
NITER = 1911    NFVAL = 1952    NSUCC =   22
TIME= 0:00:03.00

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 norm of gradient G and the cause of termination ITERM.
      Subroutine PNEDS can be verified and tested using the program
TNEDS. This program calls the subroutines TIUS14 (initiation), TFFU14
(function evaluation), TFGU14 (gradient evaluation) containing 22 box
constrained test problems with at most 1000 variables [2]. The results
obtained by the program TNEDS on a PC computer with Microsoft Power
Station Fortran compiler have the following form.

NIT= 1420  NFV= 1424  NFG= 5680  F=  0.00000000      G= 0.000E+00  ITERM=  3
NIT=  128  NFV=  130  NFG=  640  F=  1980.05047      G= 0.911E-10  ITERM=  4
NIT=   17  NFV=   19  NFG=  108  F= 0.189355864E-09  G= 0.340E-06  ITERM=  4
NIT=   10  NFV=   12  NFG=   44  F=  269.522686      G= 0.328E-09  ITERM=  4
NIT=   13  NFV=   15  NFG=   84  F= 0.391905635E-12  G= 0.536E-06  ITERM=  4
NIT=   13  NFV=   14  NFG=  196  F= 0.136396633E-11  G= 0.901E-06  ITERM=  4
NIT=   30  NFV=   32  NFG=  186  F=  336.920046      G= 0.151E-05  ITERM=  2
NIT=   37  NFV=   38  NFG=  684  F=  761925.725      G= 0.119E-06  ITERM=  4
NIT=  507  NFV=  508  NFG= 1016  F=  428.056916      G= 0.347E-13  ITERM=  4
NIT=  109  NFV=  127  NFG=  990  F= -80.4518214      G= 0.639E-06  ITERM=  4
NIT=    6  NFV=    8  NFG=   42  F=  72291.4951      G= 0.178E-08  ITERM=  4
NIT=  519  NFV=  520  NFG= 2080  F=  4994.21410      G= 0.236E-06  ITERM=  4
NIT=    3  NFV=    4  NFG=   16  F= 0.660542076E-23  G= 0.363E-11  ITERM=  3
NIT=    2  NFV=    3  NFG=   18  F= 0.129013604E-08  G= 0.792E-06  ITERM=  4
NIT=    9  NFV=   10  NFG=   40  F=  1.92401599      G= 0.414E-06  ITERM=  4
NIT=   15  NFV=   18  NFG=   96  F= -427.391653      G= 0.342E-06  ITERM=  4
NIT=    8  NFV=    9  NFG=   54  F=-0.379921091E-01  G= 0.314E-10  ITERM=  4
NIT=    7  NFV=    8  NFG=   48  F=-0.245741193E-01  G= 0.218E-09  ITERM=  4
NIT=   13  NFV=   16  NFG=   84  F=  1654.94525      G= 0.174E-08  ITERM=  4
NIT=   14  NFV=   15  NFG=   90  F= -1.00013520      G= 0.139E-08  ITERM=  4
NIT=    9  NFV=   10  NFG=   60  F=  2.41354873      G= 0.388E-08  ITERM=  4
NIT=   30  NFV=   34  NFG=  186  F=  1.00000000      G= 0.164E-08  ITERM=  4
NITER = 2919    NFVAL = 2974    NSUCC =   22
TIME= 0:00:06.56

References:
-----------

[1] Luksan L., Matonoha C., Vlcek J.: LSA: Algorithms for large-scale
    unconstrained and box constrained optimization Technical Report V-896.
    Prague, ICS AS CR, 2004.

[2] Luksan L., Vlcek J.: Sparse and partially separable test problems
    for unconstrained and equality constrained optimization. Research
    Report V-767, Institute of Computer Science, Academy of Sciences
    of the Czech Republic, Prague, Czech Republic, 1998.

***********************************************************************
*                                                                     *
*         PNET - A LIMITED MEMORY VARIABLE METRIC ALGORITHM FOR       *
*                LARGE-SCALE OPTIMIZATION.                            *
*                                                                     *
***********************************************************************


1. Introduction:
----------------

      The double-precision FORTRAN 77 basic subroutine PNET is designed
to find a close approximation to a local minimum of a nonlinear
function F(X) with simple bounds on variables. Here X is a vector of NF
variables and F(X) is a smooth function. We suppose that NF is large
but the sparsity pattern of the Hessian matrix is not known (or the
Hessian matrix is dense). 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 <= NF. To simplify user's work, two additional easy to use
subroutines are added. They call the basic general subroutine PNET:

      PNETU - unconstrained large-scale optimization,
      PNETS - large-scale optimization with simple bounds.

All subroutines contain a description of formal parameters and
extensive comments. Furthermore, two test programs TNETU and TNETS are
included, which contain several test problems (see e.g. [2]). 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 the method is
given in [1]. 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/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH

The arguments have the following meaning:

 Argument  Type Significance
 ----------------------------------------------------------------------
  NRES      O   Positive INTEGER variable that indicates the number of
                restarts.
  NDEC      O   Positive INTEGER variable that indicates the number of
                matrix decompositions.
  NIN       O   Positive INTEGER variable that indicates the number of
                inner iterations (for solving linear systems).
  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 PNETU, PNETS:
----------------------------

The calling sequences are

      CALL PNETU(NF,X,IPAR,RPAR,F,GMAX,IHES,IPRNT,ITERM)
      CALL PNETS(NF,X,IX,XL,XU,IPAR,RPAR,F,GMAX,IHES,IPRNT,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.
  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).
  IPAR(7)   I   INTEGER parameters:
                  IPAR(1)=MIT,  IPAR(2)=MFV,  IPAR(3)=MFG,
                  IPAR(4)=IEST, IPAR(5)=MOS1, IPAR(6)=MOS2,
                  IPAR(7)=MF.
                Parameters MIT, MFV, MFG, IEST, MOS1, MOS2, MF are
		    described in Section 3 together with other parameters
		    of the subroutine PNET.
  RPAR(9)   I   DOUBLE PRECISION parameters:
                  RPAR(1)=XMAX,  RPAR(2)=TOLX,  RPAR(3)=TOLF,
                  RPAR(4)=TOLB,  RPAR(5)=TOLG,  RPAR(6)=FMIN,
                  RPAR(7)-NONE,  RPAR(6)-NONE,  RPAR(9)-NONE.
                Parameters XMAX, TOLX, TOLF, TOLB, TOLG, FMIN are
                described in Section 3 together with other parameters
                of the subroutine PNET.
  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.
  IHES      I   INTEGER variable that specifies the way for computing the product 
                of the Hessian matrix and a vector.
                  IHES=0 - product is computed by using the gradient differences, 
                  IHES=1 - product is computed by using the user supplied 
                           subroutine.    
  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.
  ITERM     O   INTEGER variable that indicates the cause of termination:
                  ITERM= 1 - if |X - XO| was less than or equal to TOLX
                             in two subsequent iterations,
                  ITERM= 2 - if |F - FO| was less than or equal to TOLF
                             in two 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= 6 - if termination criterion was not satisfied,
                             but the solution is probably acceptable,
                  ITERM=11 - if NIT exceeded MIT,
                  ITERM=12 - if NFV exceeded MFV,
                  ITERM=13 - if NFG exceeded MFG,
                  ITERM< 0 - if the method failed.

      The subroutines PNETU, PNETS require the user supplied subroutines
OBJ, DOBJ and HVEC that define the objective function, its gradient and
the way for computing the product of the Hessian matrix and a vector and have
the form.

      SUBROUTINE  OBJ(NF,X,F)
      SUBROUTINE DOBJ(NF,X,G)
      SUBROUTINE HVEC(NF,X,D,HD)

The arguments of the 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 gradient of the objective function
                at the point X.
  D(NF)     I   DOUBLE PRECISION input vector.        
  HD(NF)    I   DOUBLE PRECISION output vector, which is the product of
                the Hessian matrix and the vector D.        


3. Subroutine PNET:
-------------------

      This general subroutine is called from all subroutines described
in Section 2. The calling sequence is

      CALL PNET(NF,NB,X,IX,XL,XU,GF,GN,S,XO,GO,XS,GS,XM,GM,U1,U2,XMAX,
     & TOLX,TOLF,TOLB,TOLG,FMIN,GMAX,F,IHES,MIT,MFV,MFG,IEST,MOS1,MOS2,
     & MF,IPRNT,ITERM)


The arguments NF, NB, X, IX, XL, XU, GMAX, F, IHES, IPRNT, ITERM, have the
same meaning as in Section 2. Other arguments have the following meaning:

 Argument  Type Significance
 -----------------------------------------------------------------------
  GF(NF)    A   DOUBLE PRECISION gradient of the objective function.
  GN(NF)    A   DOUBLE PRECISION old gradient of the objective function.
  S(NF)     A   DOUBLE PRECISION direction vector.
  XO(NF)    A   DOUBLE PRECISION array which contains increments of
                variables.
  GO(NF)    A   DOUBLE PRECISION array which contains increments of
                gradients.
  XS(NF)    A   DOUBLE PRECISION auxiliary array.
  GS(NF)    A   DOUBLE PRECISION auxiliary array.
  XM(NF*MF) A   DOUBLE PRECISION array which contains increments of
                variables.
  GM(NF*MF) A   DOUBLE PRECISION array which contains increments of
                gradients.
  U1(MF)    A   DOUBLE PRECISION auxiliary array.
  U2(MF)    A   DOUBLE PRECISION auxiliary array.
  XMAX      I   DOUBLE PRECISION maximum stepsize; the choice XMAX=0
                causes that the default value 1.0D+16 will be taken.
  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-14 will be taken.
  TOLB      I   DOUBLE PRECISION minimum acceptable function value;
                the choice TOLB=0 causes that the default value
                TOLB=FMIN+1.0D-16 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.
  FMIN      I   DOUBLE PRECISION lower bound for the minimum function
                value.
  MIT       I   INTEGER variable that specifies the maximum number of
                iterations; the choice MIT=0 causes that the default
                value 5000 will be taken.
  MFV       I   INTEGER variable that specifies the maximum number of
                function evaluations; the choice MFV=0 causes that
                the default value 5000 will be taken.
  MFG       I   INTEGER variable that specifies the maximum number of
                gradient evaluations; the choice MFG=0 causes that
                the default value 30000 will be taken.
  IEST      I   INTEGER estimation of the minimum functiom value for
                the line search:
                  IEST=0 - estimation is not used,
                  IEST=1 - lower bound FMIN is used as an estimation
                           for the minimum function value.
  MOS1      I   INTEGER choice of restarts after constraint change:
                  MOS1=1 - restarts are suppressed,
                  MOS1=2 - restarts with steepest descent directions are
                           used.
  MOS2      I   INTEGER choice of preconditioning strategy:
                  MOS2=1 - preconditioning is not used,
                  MOS2=2 - preconditioning by the incomplete
                            Gill-Murray decomposition,
                  MOS2=3 - preconditioning by the incomplete
                            Gill-Murray decomposition combined with
                            preliminary solution of the preconditioned
                            system.
  MF        I   The number of limited-memory variable metric updates
                in each iteration (they use 2*MF stored vectors).

The choice of parameter XMAX can be sensitive in many cases. First, the
objective function can be evaluated only in a relatively small region
(if it contains exponentials) so that the maximum stepsize is necessary.
Secondly, the problem can be very ill-conditioned far from the solution
point so that large steps can be unsuitable. Finally, if the problem has
more local solutions, a suitably chosen maximum stepsize can lead to
obtaining a better local solution.
      The subroutine PNET requires the user supplied subroutines OBJ
and DOBJ which are described in Section 2.

4. Verification of the subroutines:
-----------------------------------

      Subroutine PNETU can be verified and tested using the program
TNETU. This program calls the subroutines TIUD14 (initiation), TFFU14
(function evaluation) and TFGU14 (gradient evaluation) containing
22 unconstrained test problems with at most 1000 variables [2]. The
results obtained by the program TNETU on a PC computer with Microsoft
Power Station Fortran compiler have the following form.

NIT= 1481  NFV= 1656  NFG=26037  F= 0.117631766E-15  G= 0.354E-06  ITERM=  4
NIT=  132  NFV=  387  NFG= 7945  F= 0.153382199E-15  G= 0.988E-08  ITERM=  4
NIT=   19  NFV=   20  NFG=  110  F= 0.421204156E-09  G= 0.353E-06  ITERM=  4
NIT=   19  NFV=   20  NFG=  230  F=  269.499543      G= 0.779E-07  ITERM=  4
NIT=   12  NFV=   13  NFG=   49  F= 0.465606821E-11  G= 0.364E-06  ITERM=  4
NIT=   13  NFV=   14  NFG=   76  F= 0.366783327E-11  G= 0.404E-06  ITERM=  4
NIT=    9  NFV=   10  NFG=   37  F=  336.937181      G= 0.248E-06  ITERM=  4
NIT=   11  NFV=   12  NFG=   58  F=  761774.954      G= 0.155E-07  ITERM=  4
NIT=    7  NFV=   11  NFG=   28  F=  316.436141      G= 0.158E-07  ITERM=  4
NIT=   75  NFV=  153  NFG= 3213  F= -133.610000      G= 0.777E-08  ITERM=  4
NIT=   33  NFV=   45  NFG=  181  F=  10.7765879      G= 0.414E-07  ITERM=  4
NIT=   23  NFV=   30  NFG=  457  F=  982.273617      G= 0.591E-08  ITERM=  4
NIT=    7  NFV=    8  NFG=   16  F= 0.533593908E-15  G= 0.327E-07  ITERM=  4
NIT=    1  NFV=    2  NFG= 1005  F= 0.120245125E-08  G= 0.879E-07  ITERM=  4
NIT=   14  NFV=   15  NFG= 4033  F=  1.92401599      G= 0.468E-07  ITERM=  4
NIT=   13  NFV=   17  NFG=  295  F= -427.404476      G= 0.800E-08  ITERM=  4
NIT=    4  NFV=    5  NFG=  810  F=-0.379921091E-01  G= 0.537E-06  ITERM=  4
NIT=    4  NFV=    5  NFG= 1146  F=-0.245741193E-01  G= 0.425E-06  ITERM=  4
NIT=   10  NFV=   11  NFG= 1986  F=  59.5986241      G= 0.423E-06  ITERM=  4
NIT=   18  NFV=   39  NFG= 3051  F= -1.00013520      G= 0.712E-07  ITERM=  4
NIT=    7  NFV=    8  NFG= 4901  F=  2.13866377      G= 0.120E-08  ITERM=  4
NIT=   55  NFV=  145  NFG= 4760  F=  1.00000000      G= 0.206E-08  ITERM=  4
NITER = 1967    NFVAL = 2626    NSUCC =   22
TIME= 0:00:06.95

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 norm of gradient G and the cause of termination ITERM.
      Subroutine PNETS can be verified and tested using the program
TNETS. This program calls the subroutines TIUD14 (initiation), TFFU14
(function evaluation), TFGU14 (gradient evaluation) containing 22 box
constrained test problems with at most 1000 variables [2]. The results
obtained by the program TNETS on a PC computer with Microsoft Power
Station Fortran compiler have the following form.

NIT= 1611  NFV= 1793  NFG=28524  F=  0.00000000      G= 0.000E+00  ITERM=  3
NIT=  259  NFV=  259  NFG= 4418  F=  3930.43956      G= 0.230E-07  ITERM=  4
NIT=   17  NFV=   18  NFG=   98  F= 0.158634811E-08  G= 0.954E-06  ITERM=  4
NIT=   12  NFV=   13  NFG=  105  F=  269.522686      G= 0.103E-07  ITERM=  4
NIT=   12  NFV=   13  NFG=   49  F= 0.465606821E-11  G= 0.364E-06  ITERM=  4
NIT=   13  NFV=   14  NFG=   76  F= 0.366783327E-11  G= 0.404E-06  ITERM=  4
NIT=    9  NFV=   10  NFG=   37  F=  336.937181      G= 0.248E-06  ITERM=  4
NIT=   40  NFV=   41  NFG=  248  F=  761925.725      G= 0.281E-06  ITERM=  4
NIT=  553  NFV=  555  NFG= 2056  F=  428.056916      G= 0.850E-07  ITERM=  4
NIT=  112  NFV=  137  NFG= 2109  F= -84.1426617      G= 0.732E-06  ITERM=  4
NIT=    7  NFV=    8  NFG=   17  F=  96517.2947      G= 0.112E-11  ITERM=  4
NIT=  133  NFV=  136  NFG= 2689  F=  4994.21410      G= 0.180E-06  ITERM=  4
NIT=    7  NFV=    8  NFG=   16  F= 0.533593908E-15  G= 0.327E-07  ITERM=  4
NIT=    1  NFV=    2  NFG= 1005  F= 0.120245125E-08  G= 0.879E-07  ITERM=  4
NIT=   14  NFV=   15  NFG= 4033  F=  1.92401599      G= 0.468E-07  ITERM=  4
NIT=   12  NFV=   13  NFG=  294  F= -427.391653      G= 0.594E-06  ITERM=  4
NIT=    4  NFV=    5  NFG=  810  F=-0.379921091E-01  G= 0.537E-06  ITERM=  4
NIT=    4  NFV=    5  NFG= 1146  F=-0.245741193E-01  G= 0.425E-06  ITERM=  4
NIT=    8  NFV=    9  NFG= 1902  F=  1654.94525      G= 0.690E-07  ITERM=  4
NIT=   16  NFV=   25  NFG= 3254  F= -1.00013520      G= 0.836E-08  ITERM=  4
NIT=    4  NFV=    5  NFG= 1211  F=  2.41354873      G= 0.135E-06  ITERM=  4
NIT=   52  NFV=  137  NFG= 4843  F=  1.00000000      G= 0.657E-06  ITERM=  4
NITER = 2900    NFVAL = 3221    NSUCC =   22
TIME= 0:00:08.56


References:
-----------

[1] Luksan L., Matonoha C., Vlcek J.: LSA: Algorithms for large-scale
    unconstrained and box constrained optimization Technical Report V-896.
    Prague, ICS AS CR, 2004.

[2] Luksan L., Vlcek J.: Sparse and partially separable test problems
    for unconstrained and equality constrained optimization. Research
    Report V-767, Institute of Computer Science, Academy of Sciences
    of the Czech Republic, Prague, Czech Republic, 1998.
    
***********************************************************************
*                                                                     *
*  PSEC - VARIABLE METRIC AND DISCRETE NEWTON METHODS WITH ITERATIVE  *
*         CG-BASED LINE-SEARCH SUBALGORITHMS FOR LARGE-SCALE          *
*         PARTIALLY SEPARABLE OPTIMIZATION PROBLEMS                   *
*                                                                     *
***********************************************************************


1. Introduction:
----------------

      The double-precision FORTRAN 77 basic subroutine PSEC is designed
to find a close approximation to a local minimum of a partially separable
function

      F(X) =  FA_1(X) + FA_2(X) + ... + FA_NA(X)


with simple bounds on variables. Here X is a vector of NF variables and
FA_I(X), 1 <= I <= NA, are twice continuously differentiable functions.
We assume that NF and NA are large, but partial functions FA_I(X),
1 <= I <= NA depend on a small number of variables. This implies that
the mapping AF(X) = [FA_1(X), FA_2(X), ..., FA_NA(X)] has a sparse
Jacobian matrix, which will be denoted by AG(X) (it has NA rows and NF
columns). 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 <= NF. The sparsity pattern of the Jacobian matrix is
stored in the coordinate form if ISPAS=1 or in the standard compressed
row format if ISPAS=2 using arrays IAG and JAG. For example, if the
Jacobian matrix has the following pattern

                AG = | * * 0 * |
                     | * * * 0 |
                     | * 0 0 * |
                     | 0 * * 0 |
                     | * 0 * 0 |

(asterisks denote nonzero elements) then arrays IAG and JAG contain
elements

IAG(1)=1, IAG(2)=1, IAG(3)=1, IAG(4)=2,  IAG(5)=2,  IAG(6)=2,
IAG(7)=3, IAG(8)=3, IAG(9)=4, IAG(10)=4, IAG(11)=5, IAG(12)=5,
JAG(1)=1, JAG(2)=2, JAG(3)=4, JAG(4)=1,  JAG(5)=2,  JAG(6)=3,
JAG(7)=1, JAG(8)=4, JAG(9)=2, JAG(10)=3, JAG(11)=1, JAG(12)=3

if ISPAS=1 or

IAG(1)=1, IAG(2)=4, IAG(3)=7, IAG(4)=9,  IAG(5)=11, IAG(6)=13,
JAG(1)=1, JAG(2)=2, JAG(3)=4, JAG(4)=1,  JAG(5)=2,  JAG(6)=3,
JAG(7)=1, JAG(8)=4, JAG(9)=2, JAG(10)=3, JAG(11)=1, JAG(12)=3

if ISPAS=2. In the first case, nonzero elements can be sorted in an
arbitrary order (not only by rows as in the above example). Arrays
IAG and JAG have to be declared with lengths NA+MA and MA at least,
respectively, where MA is the number of nonzero elements. In the
second case, nonzero elements can be sorted only by rows. Components
of IAG contain total numbers of nonzero elements in all previous
rows increased by 1 and elements of JAG contain corresponding column
indices (note that IAG has NA+1 elements and the last element is
equal to MA+1). Arrays IAG and JAG have to be declared with length
NA+1 and MA at least, respectively.
      To simplify user's work, two additional easy to use subroutines
are added. They call the basic general subroutine PSEC:

      PSECU - unconstrained large-scale optimization,
      PSECS - large-scale optimization with simple bounds.

All subroutines contain a description of formal parameters and
extensive comments. Furthermore, two test programs TSECU and TSECS are
included, which contain several test problems (see e.g. [2]). 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 the method is
given in [1]. 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/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH

The arguments have the following meaning:

 Argument  Type Significance
 ----------------------------------------------------------------------
  NRES      O   Positive INTEGER variable that indicates the number of
                restarts.
  NDEC      O   Positive INTEGER variable that indicates the number of
                matrix decompositions.
  NIN       O   Positive INTEGER variable that indicates the number of
                inner iterations (for solving linear systems).
  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 PSECU, PSECS:
----------------------------

The calling sequences are

      CALL PSECU(NF,NA,MA,X,AF,IAG,JAG,IPAR,RPAR,F,GMAX,ISPAS,IPRNT,ITERM)
      CALL PSECS(NF,NA,MA,X,IX,XL,XU,AF,IAG,JAG,IPAR,RPAR,F,GMAX,ISPAS,
     & IPRNT,ITERM)

The arguments have the following meaning.

 Argument  Type Significance
 ----------------------------------------------------------------------
  NF        I   Positive INTEGER variable that specifies the number of
                variables of the partially separable function.
  NA        I   Positive INTEGER variable that specifies the number of
                partial functions.
  MA        I   Number of nonzero elements in the Jacobian matrix. This
                parameter is used as input only if ISPAS=1 (it defines
                dimensions of arrays IAG and JAG in this case).
  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).
  AF(NA)    O   DOUBLE PRECISION vector which contains values of partial
                functions.
  IAG(NA+1) I   INTEGER array which contains pointers of the first
                elements in rows of the Jacobian matrix.
  JAG(MA)   I   INTEGER array which contains column indices of the
                nonzero elements.
  IPAR(7)   I   INTEGER parameters:
                  IPAR(1)=MIT,  IPAR(2)=MFV,  IPAR(3)=MFG,
                  IPAR(4)=IEST, IPAR(5)=MET,  IPAR(6)=MOS2,
                  IPAR(7)=IFIL.
                Parameters MIT, MFV, MFG, IEST, MET are described in
                Section 3 together with other parameters of the
                subroutine PSEC. Parameter IFIL specifies a relative
                size of the space reserved for fill-in. The choice
                IFIL=0 causes that the default value IFIL=1 will be
                taken.
  RPAR(9)   I   DOUBLE PRECISION parameters:
                  RPAR(1)=XMAX,  RPAR(2)=TOLX,  RPAR(3)=TOLF,
                  RPAR(4)=TOLB,  RPAR(5)=TOLG,  RPAR(6)=FMIN,
                  RPAR(7)-NONE,  RPAR(8)-NONE,  RPAR(9)-NONE.
                Parameters XMAX, TOLX, TOLF, TOLB, TOLG, FMIN are
                described in Section 3 together with other parameters
                of the subroutine PSEC.
  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.
  ISPAS     I   INTEGER variable that specifies sparse structure of the
                Jacobian matrix:
                  ISPAS= 1 - the coordinate form is used,
                  ISPAS= 2 - the standard row compresed format is used.
  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.
  ITERM     O   INTEGER variable that indicates the cause of termination:
                  ITERM= 1 - if |X - XO| was less than or equal to TOLX
                             in two subsequent iterations,
                  ITERM= 2 - if |F - FO| was less than or equal to TOLF
                             in two 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= 6 - if termination criterion was not satisfied,
                             but the solution is probably acceptable,
                  ITERM=11 - if NIT exceeded MIT,
                  ITERM=12 - if NFV exceeded MFV,
                  ITERM=13 - if NFG exceeded MFG,
                  ITERM< 0 - if the method failed. Values ITERM<=-40
                             detect a lack of space. In this case,
                             parameter IPAR(7)=IFIL has to be increased
                             (IFIL=2, IFIL=3, etc.).

      The subroutines PSECU, PSECS require the user supplied subroutines
FUN and DFUN that define partial functions and their gradients and have
the form

      SUBROUTINE  FUN(NF,KA,X,FA)
      SUBROUTINE DFUN(NF,KA,X,GA)

The arguments of the 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   INTEGER index of the partial function.
  X(NF)     I   DOUBLE PRECISION an estimate to the solution.
  FA        O   DOUBLE PRECISION value of the KA-th partial function at
                the point X.
  GA(NF)    O   DOUBLE PRECISION gradient of the KA-th partial function
                at the point X. Note that only nonzero elements of this
                gradient have to be assigned.

3. Subroutine PSEC:
-------------------

      This general subroutine is called from all subroutines described
in Section 2. The calling sequence is

      CALL PSEC(NF,NA,NB,MMAX,X,IX,XL,XU,AF,GA,G,HA,AH,H,IH,JH,AG,IAG,
     & JAG,S,XO,GO,XS,AGO,IW,XMAX,TOLX,TOLF,TOLB,TOLG,FMIN,GMAX,F,MIT,
     & MFV,MFG,IEST,MET,MOS2,IPRNT,ITERM)

The arguments NF, NA, X, IX, XL, XU, AF, IAG, JAG, GMAX, F, IPRNT, ITERM
have the same meaning as in Section 2. Other arguments have the following
meaning:

 Argument  Type Significance
 ----------------------------------------------------------------------
  NB         I   Nonnegative INTEGER variable that specifies whether the
                 simple bounds are suppressed (NB=0) or accepted (NB>0).
  MMAX       I   INTEGER size of array H.
  GA(NF)     A   DOUBLE PRECISION gradient of the partial function.
  G(NF)      A   DOUBLE PRECISION gradient of the objective function.
  HA(ML)     A   DOUBLE PRECISION Hessian matrix of the partial function.
  AH(MH)     A   DOUBLE PRECISION approximation of the partitioned
                 Hessian matrix.
  H(MMAX)    A   DOUBLE PRECISION nonzero elements of the approximation
                 of the Hessian matrix and nonzero elements of the
                 Choleski factor.
  IH(NF+1)   I   INTEGER array which contains pointers of the diagonal
                 elements in the upper part of the Hessian matrix.
  JH(MMAX)   I   INTEGER array which contains column indices of the
                 nonzero elements and additional working space for the
                 Choleski factor.
  AG(MA)     A   DOUBLE PRECISION nonzero elements of the Jacobian
                 matrix.
  S(NF)      A   DOUBLE PRECISION direction vector.
  XO(NF)     A   DOUBLE PRECISION array which contains increments of
                 variables.
  GO(NF)     A   DOUBLE PRECISION array which contains increments of
                 gradients.
  XS(NF)     A   DOUBLE PRECISION auxiliary array.
  AGO(MA)    A   DOUBLE PRECISION difference between the current and the
                 old Jacobian matrices. This array is not used if MET=3.
  IW(NF+1)   A   INTEGER auxiliary array.
  XMAX       I   DOUBLE PRECISION maximum stepsize; the choice XMAX=0
                 causes that the default value 1.0D+16 will be taken.
  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-14 will be taken.
  TOLB       I   DOUBLE PRECISION minimum acceptable function value;
                 the choice TOLB=0 causes that the default value
                 TOLB=FMIN+1.0D-16 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.
  FMIN       I   DOUBLE PRECISION lower bound for the minimum function
                 value.
  MIT        I   INTEGER variable that specifies the maximum number of
                 iterations; the choice MIT=0 causes that the default
                 value 9000 will be taken.
  MFV        I   INTEGER variable that specifies the maximum number of
                 function evaluations; the choice MFV=0 causes that
                 the default value 9000 will be taken.
  MFG        I   INTEGER variable that specifies the maximum number of
                 gradient evaluations; the choice MFG=0 causes that
                 the default value 9000 will be taken.
  IEST       I   INTEGER estimation of the minimum functiom value for
                 the line search:
                   IEST=0 - estimation is not used,
                   IEST=1 - lower bound FMIN is used as an estimation
                            for the minimum function value.
  MET        I   INTEGER variable that specifies the variable metric
                 update:
                   MET=1 - safeguarded BFGS method,
                   MET=2 - combination of the BFGS and the symmetric
                           rank-one method,
                   MET=3 - discrete Newton method.
                 The choice MET=0 causes that the default value 2 will
                 be taken.
  MOS2       I   INTEGER variable defining a type of preconditioning.
                   MOS2=1 - Preconditioning is not used.
                   MOS2=2 - Preconditioning by the incomplete Gill-Murray
                            decomposition.
                   MOS2=3 - Preconditioning by the incomplete Gill-Murray
                            decomposition with a preliminary solution of
                            the preconditioned system which is used if
                            it satisfies the termination criterion.
                 The choice MOS2=0 causes that the default value 2 will
                 be taken.

The choice of parameter XMAX can be sensitive in many cases. First, the
objective function can be evaluated only in a relatively small region
(if it contains exponentials) so that the maximum stepsize is necessary.
Secondly, the problem can be very ill-conditioned far from the solution
point so that large steps can be unsuitable. Finally, if the problem has
more local solutions, a suitably chosen maximum stepsize can lead to
obtaining a better local solution.
      The subroutine PSEC requires the user supplied subroutines FUN
and DFUN which are described in Section 2.

4. Verification of the subroutines:
-----------------------------------

      Subroutine PSECU can be verified and tested using the program
TSECU. This program calls the subroutines TIUB14 (initiation), TAFU14
(function evaluation) and TAGU14 (gradient evaluation) containing
22 unconstrained test problems with at most 1000 variables [2]. The
results obtained by the program TSECU on a PC computer with Microsoft
Power Station Fortran compiler have the following form.

NIT= 1469  NFV= 1640  NFG= 4580  F= 0.190717059E-15  G= 0.188E-07  ITERM=  4
NIT=  137  NFV=  406  NFG=  958  F= 0.733479616E-22  G= 0.408E-10  ITERM=  3
NIT=   16  NFV=   17  NFG=   85  F= 0.302968461E-09  G= 0.400E-06  ITERM=  4
NIT=   13  NFV=   14  NFG=   70  F=  269.499543      G= 0.697E-08  ITERM=  4
NIT=   13  NFV=   14  NFG=   42  F= 0.705564252E-12  G= 0.599E-06  ITERM=  4
NIT=   13  NFV=   14  NFG=   98  F= 0.136525612E-11  G= 0.901E-06  ITERM=  4
NIT=   12  NFV=   17  NFG=   43  F=  336.937181      G= 0.260E-09  ITERM=  4
NIT=    5  NFV=    8  NFG=   38  F=  761774.954      G= 0.127E-06  ITERM=  4
NIT=    5  NFV=    9  NFG=   39  F=  316.436141      G= 0.996E-12  ITERM=  4
NIT=   60  NFV=  106  NFG=  411  F= -124.690000      G= 0.102E-08  ITERM=  4
NIT=   30  NFV=   38  NFG=  193  F=  10.7765879      G= 0.419E-06  ITERM=  4
NIT=   24  NFV=   25  NFG=   75  F=  982.273617      G= 0.161E-09  ITERM=  4
NIT=    3  NFV=    4  NFG=   12  F= 0.660547868E-23  G= 0.363E-11  ITERM=  3
NIT=    2  NFV=    4  NFG=   10  F= 0.787241903E-12  G= 0.492E-09  ITERM=  4
NIT=    4  NFV=    6  NFG=   16  F=  1.92401599      G= 0.864E-06  ITERM=  4
NIT=    9  NFV=   19  NFG=   39  F= -427.404476      G= 0.114E-12  ITERM=  4
NIT=    3  NFV=    4  NFG=   12  F=-0.379921091E-01  G= 0.158E-07  ITERM=  4
NIT=    2  NFV=    4  NFG=   10  F=-0.245741193E-01  G= 0.482E-09  ITERM=  4
NIT=    2  NFV=    5  NFG=   11  F=  59.5986241      G= 0.316E-07  ITERM=  4
NIT=   15  NFV=   33  NFG=   65  F= -1.00013520      G= 0.408E-09  ITERM=  4
NIT=    7  NFV=    8  NFG=   24  F=  2.13866377      G= 0.909E-06  ITERM=  4
NIT=   44  NFV=  107  NFG=  197  F=  1.00000000      G= 0.435E-07  ITERM=  4
NITER = 1888    NFVAL = 2502    NITCG = 9154    NSUCC =   22
TIME= 0:00:02.95

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 norm of gradient G and the cause of termination ITERM.
      Subroutine PSECS can be verified and tested using the program
TSECS. This program calls the subroutines TIUB14 (initiation), TAFU14
(function evaluation), TAGU14 (gradient evaluation) containing 22 box
constrained test problems with at most 1000 variables [2]. The results
obtained by the program TSEDS on a PC computer with Microsoft Power
Station Fortran compiler have the following form.

NIT= 2598  NFV= 3347  NFG= 3347  F=  0.00000000      G= 0.000E+00  ITERM=  3
NIT=  352  NFV=  361  NFG=  361  F=  35.1211309      G= 0.853E-05  ITERM=  2
NIT=   39  NFV=   43  NFG=   43  F= 0.441691822E-12  G= 0.425E-06  ITERM=  4
NIT=   21  NFV=   22  NFG=   22  F=  269.522686      G= 0.105E-06  ITERM=  4
NIT=   16  NFV=   17  NFG=   17  F= 0.783032535E-11  G= 0.279E-06  ITERM=  4
NIT=   32  NFV=   33  NFG=   33  F= 0.959526458E-11  G= 0.801E-06  ITERM=  4
NIT=   19  NFV=   21  NFG=   21  F=  337.722479      G= 0.162E-05  ITERM=  2
NIT=   46  NFV=   49  NFG=   49  F=  761925.725      G= 0.792E-04  ITERM=  2
NIT= 1001  NFV= 1003  NFG= 1003  F=  428.056916      G= 0.348E-08  ITERM=  4
NIT=  203  NFV=  233  NFG=  233  F= -86.7188428      G= 0.288E-04  ITERM=  2
NIT=   21  NFV=   38  NFG=   38  F=  72291.4951      G= 0.135E-10  ITERM=  4
NIT=  223  NFV=  230  NFG=  230  F=  4994.21410      G= 0.303E-06  ITERM=  4
NIT=    1  NFV=    2  NFG=    2  F=  0.00000000      G= 0.000E+00  ITERM=  3
NIT=   25  NFV=   28  NFG=   28  F= 0.104289348E-08  G= 0.927E-06  ITERM=  4
NIT=   17  NFV=   27  NFG=   27  F=  1.92401599      G= 0.553E-07  ITERM=  4
NIT=   21  NFV=   22  NFG=   22  F= -427.391653      G= 0.759E-06  ITERM=  4
NIT=   15  NFV=   17  NFG=   17  F=-0.379921091E-01  G= 0.299E-06  ITERM=  4
NIT=    8  NFV=   12  NFG=   12  F=-0.245741193E-01  G= 0.358E-11  ITERM=  4
NIT=   20  NFV=   25  NFG=   25  F=  1654.94525      G= 0.351E-06  ITERM=  4
NIT=   33  NFV=   46  NFG=   46  F= -1.00013520      G= 0.959E-10  ITERM=  4
NIT=   27  NFV=   31  NFG=   31  F=  2.41354873      G= 0.202E-06  ITERM=  4
NIT=   51  NFV=  185  NFG=  185  F=  1.00000000      G= 0.834E-06  ITERM=  4
NITER = 4789    NFVAL = 5792    NITCG =15187    NSUCC =   22
TIME= 0:00:06.32

References:
-----------

[1] Luksan L., Matonoha C., Vlcek J.: LSA: Algorithms for large-scale
    unconstrained and box constrained optimization Technical Report V-896.
    Prague, ICS AS CR, 2004.

[2] Luksan L., Vlcek J.: Sparse and partially separable test problems
    for unconstrained and equality constrained optimization. Research
    Report V-767, Institute of Computer Science, Academy of Sciences
    of the Czech Republic, Prague, Czech Republic, 1998.

***********************************************************************
*                                                                     *
*  PSED - VARIABLE METRIC AND DISCRETE NEWTON METHODS WITH DIRECT     *
*         DECOMPOSITION LINE-SEARCH SUBALGORITHMS FOR LARGE-SCALE     *
*         PARTIALLY SEPARABLE OPTIMIZATION PROBLEMS                   *
*                                                                     *
***********************************************************************


1. Introduction:
----------------

      The double-precision FORTRAN 77 basic subroutine PSED is designed
to find a close approximation to a local minimum of a partially separable
function

      F(X) =  FA_1(X) + FA_2(X) + ... + FA_NA(X)


with simple bounds on variables. Here X is a vector of NF variables and
FA_I(X), 1 <= I <= NA, are twice continuously differentiable functions.
We assume that NF and NA are large, but partial functions FA_I(X),
1 <= I <= NA depend on a small number of variables. This implies that
the mapping AF(X) = [FA_1(X), FA_2(X), ..., FA_NA(X)] has a sparse
Jacobian matrix, which will be denoted by AG(X) (it has NA rows and NF
columns). 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 <= NF. The sparsity pattern of the Jacobian matrix is
stored in the coordinate form if ISPAS=1 or in the standard compressed
row format if ISPAS=2 using arrays IAG and JAG. For example, if the
Jacobian matrix has the following pattern

                AG = | * * 0 * |
                     | * * * 0 |
                     | * 0 0 * |
                     | 0 * * 0 |
                     | * 0 * 0 |

(asterisks denote nonzero elements) then arrays IAG and JAG contain
elements

IAG(1)=1, IAG(2)=1, IAG(3)=1, IAG(4)=2,  IAG(5)=2,  IAG(6)=2,
IAG(7)=3, IAG(8)=3, IAG(9)=4, IAG(10)=4, IAG(11)=5, IAG(12)=5,
JAG(1)=1, JAG(2)=2, JAG(3)=4, JAG(4)=1,  JAG(5)=2,  JAG(6)=3,
JAG(7)=1, JAG(8)=4, JAG(9)=2, JAG(10)=3, JAG(11)=1, JAG(12)=3

if ISPAS=1 or

IAG(1)=1, IAG(2)=4, IAG(3)=7, IAG(4)=9,  IAG(5)=11, IAG(6)=13,
JAG(1)=1, JAG(2)=2, JAG(3)=4, JAG(4)=1,  JAG(5)=2,  JAG(6)=3,
JAG(7)=1, JAG(8)=4, JAG(9)=2, JAG(10)=3, JAG(11)=1, JAG(12)=3

if ISPAS=2. In the first case, nonzero elements can be sorted in an
arbitrary order (not only by rows as in the above example). Arrays
IAG and JAG have to be declared with lengths NA+MA and MA at least,
respectively, where MA is the number of nonzero elements. In the
second case, nonzero elements can be sorted only by rows. Components
of IAG contain total numbers of nonzero elements in all previous
rows increased by 1 and elements of JAG contain corresponding column
indices (note that IAG has NA+1 elements and the last element is
equal to MA+1). Arrays IAG and JAG have to be declared with length
NA+1 and MA at least, respectively.
      To simplify user's work, two additional easy to use subroutines
are added. They call the basic general subroutine PSED:

      PSEDU - unconstrained large-scale optimization,
      PSEDS - large-scale optimization with simple bounds.

All subroutines contain a description of formal parameters and
extensive comments. Furthermore, two test programs TSEDU and TSEDS are
included, which contain several test problems (see e.g. [2]). 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 the method is
given in [1]. 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/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH

The arguments have the following meaning:

 Argument  Type Significance
 ----------------------------------------------------------------------
  NRES      O   Positive INTEGER variable that indicates the number of
                restarts.
  NDEC      O   Positive INTEGER variable that indicates the number of
                matrix decompositions.
  NIN       O   Positive INTEGER variable that indicates the number of
                inner iterations (for solving linear systems).
  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 PSEDU, PSEDS:
----------------------------

The calling sequences are

      CALL PSEDU(NF,NA,MA,X,AF,IAG,JAG,IPAR,RPAR,F,GMAX,ISPAS,IPRNT,ITERM)
      CALL PSEDS(NF,NA,MA,X,IX,XL,XU,AF,IAG,JAG,IPAR,RPAR,F,GMAX,ISPAS,
     & IPRNT,ITERM)

The arguments have the following meaning.

 Argument  Type Significance
 ----------------------------------------------------------------------
  NF        I   Positive INTEGER variable that specifies the number of
                variables of the partially separable function.
  NA        I   Positive INTEGER variable that specifies the number of
                partial functions.
  MA        I   Number of nonzero elements in the Jacobian matrix. This
                parameter is used as input only if ISPAS=1 (it defines
                dimensions of arrays IAG and JAG in this case).
  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).
  AF(NA)    O   DOUBLE PRECISION vector which contains values of partial
                functions.
  IAG(NA+1) I   INTEGER array which contains pointers of the first
                elements in rows of the Jacobian matrix.
  JAG(MA)   I   INTEGER array which contains column indices of the
                nonzero elements.
  IPAR(7)   I   INTEGER parameters:
                  IPAR(1)=MIT,  IPAR(2)=MFV,  IPAR(3)=MFG,
                  IPAR(4)=IEST, IPAR(5)=MET,  IPAR(6)-NONE,
                  IPAR(7)=IFIL.
                Parameters MIT, MFV, MFG, IEST, MET are described in
                Section 3 together with other parameters of the
                subroutine PSED. Parameter IFIL specifies a relative
                size of the space reserved for fill-in. The choice
                IFIL=0 causes that the default value IFIL=1 will be
                taken.
  RPAR(9)   I   DOUBLE PRECISION parameters:
                  RPAR(1)=XMAX,  RPAR(2)=TOLX,  RPAR(3)=TOLF,
                  RPAR(4)=TOLB,  RPAR(5)=TOLG,  RPAR(6)=FMIN,
                  RPAR(7)-NONE,  RPAR(8)-NONE,  RPAR(9)-NONE.
                Parameters XMAX, TOLX, TOLF, TOLB, TOLG, FMIN are
                described in Section 3 together with other parameters
                of the subroutine PSED.
  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.
  ISPAS     I   INTEGER variable that specifies sparse structure of the
                Jacobian matrix:
                  ISPAS= 1 - the coordinate form is used,
                  ISPAS= 2 - the standard row compresed format is used.
  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.
  ITERM     O   INTEGER variable that indicates the cause of termination:
                  ITERM= 1 - if |X - XO| was less than or equal to TOLX
                             in two subsequent iterations,
                  ITERM= 2 - if |F - FO| was less than or equal to TOLF
                             in two 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= 6 - if termination criterion was not satisfied,
                             but the solution is probably acceptable,
                  ITERM=11 - if NIT exceeded MIT,
                  ITERM=12 - if NFV exceeded MFV,
                  ITERM=13 - if NFG exceeded MFG,
                  ITERM< 0 - if the method failed. Values ITERM<=-40
                             detect a lack of space. In this case,
                             parameter IPAR(7)=IFIL has to be increased
                             (IFIL=2, IFIL=3, etc.).

      The subroutines PSEDU, PSEDS require the user supplied subroutines
FUN and DFUN that define partial functions and their gradients and have
the form

      SUBROUTINE  FUN(NF,KA,X,FA)
      SUBROUTINE DFUN(NF,KA,X,GA)

The arguments of the 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   INTEGER index of the partial function.
  X(NF)     I   DOUBLE PRECISION an estimate to the solution.
  FA        O   DOUBLE PRECISION value of the KA-th partial function at
                the point X.
  GA(NF)    O   DOUBLE PRECISION gradient of the KA-th partial function
                at the point X. Note that only nonzero elements of this
                gradient have to be assigned.

3. Subroutine PSED:
-------------------

      This general subroutine is called from all subroutines described
in Section 2. The calling sequence is

      CALL PSED(NF,NA,NB,MMAX,X,IX,XL,XU,AF,GA,G,HA,AH,H,IH,JH,AG,IAG,
     & JAG,S,XO,GO,AGO,PSL,PERM,INVP,WN11,WN12,WN13,WN14,XMAX,TOLX,
     & TOLF,TOLB,TOLG,FMIN,GMAX,F,MIT,MFV,MFG,IEST,MET,IPRNT,ITERM)

The arguments NF, NA, X, IX, XL, XU, AF, IAG, JAG, GMAX, F, IPRNT, ITERM
have the same meaning as in Section 2. Other arguments have the following
meaning:

 Argument  Type Significance
 ----------------------------------------------------------------------
  NB         I   Nonnegative INTEGER variable that specifies whether the
                 simple bounds are suppressed (NB=0) or accepted (NB>0).
  MMAX       I   INTEGER size of array H.
  GA(NF)     A   DOUBLE PRECISION gradient of the partial function.
  G(NF)      A   DOUBLE PRECISION gradient of the objective function.
  HA(ML)     A   DOUBLE PRECISION Hessian matrix of the partial function.
  AH(MH)     A   DOUBLE PRECISION approximation of the partitioned
                 Hessian matrix.
  H(MMAX)    A   DOUBLE PRECISION nonzero elements of the approximation
                 of the Hessian matrix and nonzero elements of the
                 Choleski factor.
  IH(NF+1)   I   INTEGER array which contains pointers of the diagonal
                 elements in the upper part of the Hessian matrix.
  JH(MMAX)   I   INTEGER array which contains column indices of the
                 nonzero elements and additional working space for the
                 Choleski factor.
  AG(MA)     A   DOUBLE PRECISION nonzero elements of the Jacobian
                 matrix.
  S(NF)      A   DOUBLE PRECISION direction vector.
  XO(NF)     A   DOUBLE PRECISION array which contains increments of
                 variables.
  GO(NF)     A   DOUBLE PRECISION array which contains increments of
                 gradients.
  AGO(MA)    A   DOUBLE PRECISION difference between the current and the
                 old Jacobian matrices. This array is not used if MET=3.
  PSL(NF+1)  A   INTEGER pointer vector in the compact form of the
                 Choleski factor.
  PERM(NF)   A   INTEGER permutation vector.
  INVP(NF)   A   INTEGER inverse permutation vector.
  WN11(NF+1) A   INTEGER auxiliary array.
  WN12(NF+1) A   INTEGER auxiliary array.
  WN13(NF+1) A   INTEGER auxiliary array.
  WN14(NF+1) A   INTEGER auxiliary array.
  XMAX       I   DOUBLE PRECISION maximum stepsize; the choice XMAX=0
                 causes that the default value 1.0D+16 will be taken.
  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-14 will be taken.
  TOLB       I   DOUBLE PRECISION minimum acceptable function value;
                 the choice TOLB=0 causes that the default value
                 TOLB=FMIN+1.0D-16 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.
  FMIN       I   DOUBLE PRECISION lower bound for the minimum function
                 value.
  MIT        I   INTEGER variable that specifies the maximum number of
                 iterations; the choice MIT=0 causes that the default
                 value 9000 will be taken.
  MFV        I   INTEGER variable that specifies the maximum number of
                 function evaluations; the choice MFV=0 causes that
                 the default value 9000 will be taken.
  MFG        I   INTEGER variable that specifies the maximum number of
                 gradient evaluations; the choice MFG=0 causes that
                 the default value 9000 will be taken.
  IEST       I   INTEGER estimation of the minimum functiom value for
                 the line search:
                   IEST=0 - estimation is not used,
                   IEST=1 - lower bound FMIN is used as an estimation
                            for the minimum function value.
  MET        I   INTEGER variable that specifies the variable metric
                 update:
                   MET=1 - safeguarded BFGS method,
                   MET=2 - combination of the BFGS and the symmetric
                           rank-one method,
                   MET=3 - discrete Newton method.
                 The choice MET=0 causes that the default value 2 will
                 be taken.

The choice of parameter XMAX can be sensitive in many cases. First, the
objective function can be evaluated only in a relatively small region
(if it contains exponentials) so that the maximum stepsize is necessary.
Secondly, the problem can be very ill-conditioned far from the solution
point so that large steps can be unsuitable. Finally, if the problem has
more local solutions, a suitably chosen maximum stepsize can lead to
obtaining a better local solution.
      The subroutine PSED requires the user supplied subroutines FUN
and DFUN which are described in Section 2.

4. Verification of the subroutines:
-----------------------------------

      Subroutine PSEDU can be verified and tested using the program
TSEDU. This program calls the subroutines TIUB14 (initiation), TAFU14
(function evaluation) and TAGU14 (gradient evaluation) containing
22 unconstrained test problems with at most 1000 variables [2]. The
results obtained by the program TSEDU on a PC computer with Microsoft
Power Station Fortran compiler have the following form.

NIT= 2654  NFV= 3627  NFG= 3627  F= 0.794789730E-16  G= 0.213E-06  ITERM=  3
NIT=  105  NFV=  179  NFG=  179  F=  83.3161404      G= 0.498E-06  ITERM=  4
NIT=   40  NFV=   45  NFG=   45  F= 0.267007684E-12  G= 0.823E-06  ITERM=  4
NIT=   37  NFV=   45  NFG=   45  F=  269.499543      G= 0.605E-06  ITERM=  4
NIT=   16  NFV=   17  NFG=   17  F= 0.106026711E-11  G= 0.728E-06  ITERM=  4
NIT=   38  NFV=   40  NFG=   40  F= 0.546961387E-11  G= 0.882E-06  ITERM=  4
NIT=   22  NFV=   26  NFG=   26  F=  335.252624      G= 0.105E-06  ITERM=  4
NIT=   26  NFV=   40  NFG=   40  F=  761774.954      G= 0.295E-04  ITERM=  2
NIT=  193  NFV=  202  NFG=  202  F=  316.436141      G= 0.155E-05  ITERM=  2
NIT=  227  NFV=  258  NFG=  258  F= -125.810000      G= 0.351E-04  ITERM=  2
NIT=  100  NFV=  127  NFG=  127  F=  10.7765879      G= 0.566E-06  ITERM=  4
NIT=   28  NFV=   29  NFG=   29  F=  982.273617      G= 0.102E-06  ITERM=  4
NIT=    1  NFV=    2  NFG=    2  F=  0.00000000      G= 0.000E+00  ITERM=  3
NIT=   25  NFV=   28  NFG=   28  F= 0.104289352E-08  G= 0.927E-06  ITERM=  4
NIT=    8  NFV=   15  NFG=   15  F=  1.92401599      G= 0.482E-07  ITERM=  4
NIT=   25  NFV=   35  NFG=   35  F= -427.404476      G= 0.130E-06  ITERM=  4
NIT=   15  NFV=   17  NFG=   17  F=-0.379921091E-01  G= 0.141E-06  ITERM=  4
NIT=    5  NFV=   11  NFG=   11  F=-0.245741193E-01  G= 0.311E-07  ITERM=  4
NIT=   19  NFV=   23  NFG=   23  F=  59.5986241      G= 0.466E-06  ITERM=  4
NIT=   37  NFV=   97  NFG=   97  F= -1.00013520      G= 0.212E-08  ITERM=  4
NIT=   37  NFV=   40  NFG=   40  F=  2.13866377      G= 0.767E-06  ITERM=  4
NIT=   55  NFV=  211  NFG=  211  F=  1.00000000      G= 0.610E-07  ITERM=  4
NITER = 3713    NFVAL = 5114    NSUCC =   22
TIME= 0:00:04.27

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 norm of gradient G and the cause of termination ITERM.
      Subroutine PSEDS can be verified and tested using the program
TSEDS. This program calls the subroutines TIUB14 (initiation), TAFU14
(function evaluation), TAGU14 (gradient evaluation) containing 22 box
constrained test problems with at most 1000 variables [2]. The results
obtained by the program TSEDS on a PC computer with Microsoft Power
Station Fortran compiler have the following form.

NIT= 2591  NFV= 3322  NFG= 3322  F=  0.00000000      G= 0.000E+00  ITERM=  3
NIT=  344  NFV=  347  NFG=  347  F=  35.1211309      G= 0.107E-06  ITERM=  4
NIT=   39  NFV=   43  NFG=   43  F= 0.441691821E-12  G= 0.425E-06  ITERM=  4
NIT=   21  NFV=   22  NFG=   22  F=  269.522686      G= 0.105E-06  ITERM=  4
NIT=   16  NFV=   17  NFG=   17  F= 0.783032535E-11  G= 0.279E-06  ITERM=  4
NIT=   32  NFV=   33  NFG=   33  F= 0.959526458E-11  G= 0.801E-06  ITERM=  4
NIT=   19  NFV=   21  NFG=   21  F=  337.722479      G= 0.247E-06  ITERM=  4
NIT=   52  NFV=   56  NFG=   56  F=  761925.725      G= 0.780E-04  ITERM=  2
NIT= 1001  NFV= 1003  NFG= 1003  F=  428.056916      G= 0.192E-06  ITERM=  4
NIT=  191  NFV=  222  NFG=  222  F= -86.7038382      G= 0.225E-05  ITERM=  2
NIT=   13  NFV=   18  NFG=   18  F=  72291.4951      G= 0.285E-08  ITERM=  4
NIT=  228  NFV=  235  NFG=  235  F=  4994.21410      G= 0.304E-06  ITERM=  4
NIT=    1  NFV=    2  NFG=    2  F=  0.00000000      G= 0.000E+00  ITERM=  3
NIT=   25  NFV=   28  NFG=   28  F= 0.104289352E-08  G= 0.927E-06  ITERM=  4
NIT=    8  NFV=   15  NFG=   15  F=  1.92401599      G= 0.534E-07  ITERM=  4
NIT=   21  NFV=   22  NFG=   22  F= -427.391653      G= 0.759E-06  ITERM=  4
NIT=   15  NFV=   17  NFG=   17  F=-0.379921091E-01  G= 0.299E-06  ITERM=  4
NIT=    5  NFV=   10  NFG=   10  F=-0.245741193E-01  G= 0.193E-07  ITERM=  4
NIT=   20  NFV=   25  NFG=   25  F=  1654.94525      G= 0.351E-06  ITERM=  4
NIT=   78  NFV=  130  NFG=  130  F= -1.00013520      G= 0.196E-06  ITERM=  4
NIT=   27  NFV=   31  NFG=   31  F=  2.41354873      G= 0.202E-06  ITERM=  4
NIT=   52  NFV=  190  NFG=  190  F=  1.00000000      G= 0.418E-06  ITERM=  4
NITER = 4799    NFVAL = 5809    NSUCC =   22
TIME= 0:00:07.68

References:
-----------

[1] Luksan L., Matonoha C., Vlcek J.: LSA: Algorithms for large-scale
    unconstrained and box constrained optimization Technical Report V-896.
    Prague, ICS AS CR, 2004.

[2] Luksan L., Vlcek J.: Sparse and partially separable test problems
    for unconstrained and equality constrained optimization. Research
    Report V-767, Institute of Computer Science, Academy of Sciences
    of the Czech Republic, Prague, Czech Republic, 1998.

***********************************************************************
*                                                                     *
*    PSEN - A BUNDLE VARIABLE METRIC ALGORITHM FOR OPTIMIZATION OF    *
*           LARGE-SCALE NONSMOOTH PARTIALLY SEPARABLE FUNCTIONS.      *
*                                                                     *
***********************************************************************


1. Introduction:
----------------

      The double-precision FORTRAN 77 basic subroutine PSEN is designed
to find a close approximation to a local minimum of a partially separable
objective function

      F(X) =  FA_1(X) + FA_2(X) + ... + FA_NA(X).

Here X is a vector of NF variables and FA_I(X), 1 <= I <= NA, are
locally Lipschitz nonsmooth functions. We assume that NF and NA are
large, but partial functions FA_I(X), 1 <= I <= NA, depend on a small
number of variables. This implies that the nonsmooth mapping
AF(X) = [FA_1(X), FA_2(X), ..., FA_NA(X)] has a sparse subdifferential
containing generalized Jacobian matrices, which will be denoted by AG(X)
(they have NA rows and NF columns). The sparsity pattern of the Jacobian
matrix is stored in the coordinate form if ISPAS=1 or in the standard
compressed row format if ISPAS=2 using arrays IAG and JAG. For example,
if the Jacobian matrix has the following pattern

                AG = | * * 0 * |
                     | * * * 0 |
                     | * 0 0 * |
                     | 0 * * 0 |
                     | * 0 * 0 |

(asterisks denote nonzero elements) then arrays IAG and JAG contain
elements

IAG(1)=1, IAG(2)=1, IAG(3)=1, IAG(4)=2,  IAG(5)=2,  IAG(6)=2,
IAG(7)=3, IAG(8)=3, IAG(9)=4, IAG(10)=4, IAG(11)=5, IAG(12)=5,
JAG(1)=1, JAG(2)=2, JAG(3)=4, JAG(4)=1,  JAG(5)=2,  JAG(6)=3,
JAG(7)=1, JAG(8)=4, JAG(9)=2, JAG(10)=3, JAG(11)=1, JAG(12)=3

if ISPAS=1 or

IAG(1)=1, IAG(2)=4, IAG(3)=7, IAG(4)=9,  IAG(5)=11, IAG(6)=13,
JAG(1)=1, JAG(2)=2, JAG(3)=4, JAG(4)=1,  JAG(5)=2,  JAG(6)=3,
JAG(7)=1, JAG(8)=4, JAG(9)=2, JAG(10)=3, JAG(11)=1, JAG(12)=3

if ISPAS=2. In the first case, nonzero elements can be sorted in an
arbitrary order (not only by rows as in the above example). Arrays
IAG and JAG have to be declared with lengths NA+MA and MA at least,
respectively, where MA is the number of nonzero elements. In the
second case, nonzero elements can be sorted only by rows. Components
of IAG contain total numbers of nonzero elements in all previous
rows increased by 1 and elements of JAG contain corresponding column
indices (note that IAG has NA+1 elements and the last element is
equal to MA+1). Arrays IAG and JAG have to be declared with length
NA+1 and MA at least, respectively.
      To simplify user's work, an additional easy to use subroutine
PSENU is added. It calls the basic general subroutine PSEN. All
subroutines contain a description of formal parameters and extensive
comments. Furthermore, test program TSENU is included, which contains
several test problems (see e.g. [2]). This test program serves as an
example for using the subroutine PSENU, verifies its correctness and
demonstrates its efficiency.
      In this short guide, we describe all subroutines which can be
called from the user's program. A detailed description of the method is
given in [1]. 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/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH

The arguments have the following meaning:

 Argument  Type Significance
 ----------------------------------------------------------------------
  NRES      O   Positive INTEGER variable that indicates the number of
                restarts.
  NDEC      O   Positive INTEGER variable that indicates the number of
                matrix decompositions.
  NIN       O   Positive INTEGER variable that indicates the number of
                inner iterations (for solving linear systems).
  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. Subroutine PSENU:
--------------------

The calling sequence is

      CALL PSENU(NF,NA,MA,X,AF,IAG,JAG,IPAR,RPAR,F,GMAX,ISPAS,IPRNT,ITERM)

The arguments have the following meaning.

 Argument  Type Significance
 ----------------------------------------------------------------------
  NF        I   Positive INTEGER variable that specifies the number of
                variables of the partially separable function.
  NA        I   Positive INTEGER variable that specifies the number of
                partial functions.
  MA        I   Number of nonzero elements in the Jacobian matrix. This
                parameter is used as input only if ISPAS=1 (it defines
                dimensions of arrays IAG and JAG in this case).
  X(NF)     U   On input, DOUBLE PRECISION vector with the initial
                estimate to the solution. On output, the approximation
                to the minimum.
  AF(NA)    O   DOUBLE PRECISION vector which contains values of partial
                functions.
  IAG(NA+1) I   INTEGER array which contains pointers of the first
                elements in rows of the Jacobian matrix.
  JAG(MA)   I   INTEGER array which contains column indices of the
                nonzero elements.
  IPAR(7)   I   INTEGER parameters:
                  IPAR(1)=MIT,  IPAR(2)=MFV,  IPAR(3)-NONE,
                  IPAR(4)=IEST, IPAR(5)-NONE, IPAR(6)=MB,
                  IPAR(7)=IFIL.
                Parameters MIT, MFV, IEST, MB are described in Section 3
                together with other parameters of the subroutine PSEN.
                Parameter IFIL specifies a relative size of the space
                reserved for fill-in. The choice IFIL=0 causes that the
                default value IFIL=1 will be taken.
  RPAR(9)   I   DOUBLE PRECISION parameters:
                  RPAR(1)=XMAX,  RPAR(2)=TOLX,  RPAR(3)=TOLF,
                  RPAR(4)=TOLB,  RPAR(5)=TOLG,  RPAR(6)=FMIN,
                  RPAR(7)-NONE,  RPAR(8)=ETA3,  RPAR(9)=ETA5.
                Parameters XMAX, TOLX, TOLF, TOLB, TOLG, FMIN, ETA3, ETA5
                are described in Section 3 together with other parameters
                of the subroutine PSEN.
  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.
  ISPAS     I   INTEGER variable that specifies sparse structure of the
                Jacobian matrix:
                  ISPAS= 1 - the coordinate form is used,
                  ISPAS= 2 - the standard row compresed format is used.
  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.
  ITERM     O   INTEGER variable that indicates the cause of termination:
                  ITERM= 1 - if |X - XO| was less than or equal to TOLX
                             in two subsequent iterations,
                  ITERM= 2 - if |F - FO| was less than or equal to TOLF
                             in two 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= 6 - if termination criterion was not satisfied,
                             but the solution is probably acceptable,
                  ITERM=11 - if NIT exceeded MIT,
                  ITERM=12 - if NFV exceeded MFV,
                  ITERM< 0 - if the method failed. Values ITERM<=-40
                             detect a lack of space. In this case,
                             parameter IPAR(7)=IFIL has to be increased
                             (IFIL=2, IFIL=3, etc.).

      The subroutine PSENU requires the user supplied subroutines FUN and
DFUN that define partial functions and their subgradients and have the
form

      SUBROUTINE  FUN(NF,KA,X,FA)
      SUBROUTINE DFUN(NF,KA,X,GA)

The arguments of the 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   INTEGER index of the partial function.
  X(NF)     I   DOUBLE PRECISION an estimate to the solution.
  FA        O   DOUBLE PRECISION value of the KA-th partial function at
                the point X.
  GA(NF)    O   DOUBLE PRECISION an arbitrary subgradient of the KA-th
                partial function at the point X. Note that only nonzero
                elements of this subgradient have to be assigned.


3. Subroutine PSEN:
-------------------

      This general subroutine is called from all subroutines described
in Section 2. The calling sequence is

      CALL PSEN(NF,NA,MB,MMAX,X,IX,AF,AG,AGO,AH,GA,G,H,IH,JH,IAG,
     & JAG,S,XO,GO,XS,GS,GP,AX,AY,AZ,PSL,PERM,INVP,WN11,WN12,WN13,
     & WN14,XMAX,TOLX,TOLF,TOLB,TOLG,FMIN,ETA3,ETA5,GMAX,F,MIT,MFV,
     & IEST,IPRNT,ITERM)

The arguments NF, NA, X, AF, IAG, JAG, GMAX, F, IPRNT, ITERM have the
same meaning as in Section 2. Other arguments have the following meaning:

 Argument  Type Significance
 ----------------------------------------------------------------------
  MB         I   INTEGER dimension of a bundle used in the line search.
  MMAX       I   INTEGER size of array H.
  IX(NF)     A   INTEGER auxiliary array.
  AG(MA)     A   DOUBLE PRECISION nonzero elements of the Jacobian
                 matrix.
  AGO(MA)    A   DOUBLE PRECISION auxiliary array.
  AH(MH)     A   DOUBLE PRECISION approximation of the partitioned
                 Hessian matrix.
  GA(NF)     A   DOUBLE PRECISION gradient of the partial function.
  G(NF)      A   DOUBLE PRECISION gradient of the objective function.
  H(MMAX)    A   DOUBLE PRECISION nonzero elements of the approximation
                 of the Hessian matrix and nonzero elements of the
                 Choleski factor.
  IH(NF+1)   I   INTEGER array which contains pointers of the diagonal
                 elements in the upper part of the Hessian matrix.
  JH(MMAX)   I   INTEGER array which contains column indices of the
                 nonzero elements and additional working space for the
                 Choleski factor.
  S(NF)      A   DOUBLE PRECISION direction vector.
  XO(NF)     A   DOUBLE PRECISION array which contains increments of
                 variables.
  GO(NF)     A   DOUBLE PRECISION array which contains increments of
                 gradients.
  XS(NF)     A   DOUBLE PRECISION auxiliary array.
  GS(NF)     A   DOUBLE PRECISION auxiliary array.
  GP(NF)     A   DOUBLE PRECISION auxiliary array.
  AX(NF*MB)  A   DOUBLE PRECISION auxiliary array.
  AY(NF*MB)  A   DOUBLE PRECISION auxiliary array.
  AZ(4*MB)   A   DOUBLE PRECISION auxiliary array.
  PSL(NF+1)  A   INTEGER pointer vector in the compact form of the
                 Choleski factor.
  PERM(NF)   A   INTEGER permutation vector.
  INVP(NF)   A   INTEGER inverse permutation vector.
  WN11(NF+1) A   INTEGER auxiliary array.
  WN12(NF+1) A   INTEGER auxiliary array.
  WN13(NF+1) A   INTEGER auxiliary array.
  WN14(NF+1) A   INTEGER auxiliary array.
  XMAX       I   DOUBLE PRECISION maximum stepsize; the choice XMAX=0
                 causes that the default value 1.0D+16 will be taken.
  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-12 will be taken.
  TOLB       I   DOUBLE PRECISION minimum acceptable function value;
                 the choice TOLB=0 causes that the default value
                 TOLB=FMIN+1.0D-12 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-8 will be taken.
  FMIN       I   DOUBLE PRECISION lower bound for the minimum function
                 value.
  ETA3       I   DOUBLE PRECISION correction parameter; the choice ETA3=0
                 causes that the default value ETA3=1.0D-12 will be taken.
  ETA5       I   DOUBLE PRECISION parameter for subgradient locality
                 measure; the choice ETA5=0 causes that the default value
                 ETA5=1.0D-12 will be taken.
  MIT        I   INTEGER variable that specifies the maximum number of
                 iterations; the choice MIT=0 causes that the default
                 value 9000 will be taken.
  MFV        I   INTEGER variable that specifies the maximum number of
                 function evaluations; the choice MFV=0 causes that
                 the default value 9000 will be taken.
  IEST       I   INTEGER estimation of the minimum functiom value for
                 the line search:
                  IEST=0 - estimation is not used,
                  IEST=1 - lower bound FMIN is used as an estimation
                           for the minimum function value.

The choice of parameter XMAX can be sensitive in many cases. First, the
objective function can be evaluated only in a relatively small region
(if it contains exponentials) so that the maximum stepsize is necessary.
Secondly, the problem can be very ill-conditioned far from the solution
point so that large steps can be unsuitable. Finally, if the problem has
more local solutions, a suitably chosen maximum stepsize can lead to
obtaining a better local solution. A suitable choice of parameter ETA5
can sometimes improve the efficiency of the method.
      The subroutine PSEN requires the user supplied subroutines FUN
and DFUN which are described in Section 2.

4. Verification of the subroutines:
-----------------------------------

      Subroutine PSENU can be verified and tested using the program
TSENU. This program calls the subroutines TIUB15 (initiation), TAFU15
(function evaluation) and TAGU15 (gradient evaluation) containing
22 unconstrained test problems with at most 200 variables [2]. The
results obtained by the program TSENU on a PC computer with Microsoft
Power Station Fortran compiler have the following form.

NIT= 3124  NFV= 3134  NFG= 3134  F= 0.287703261E-08  G= 0.582E-08  ITERM=  4
NIT=  286  NFV=  287  NFG=  287  F= 0.379499216E-08  G= 0.203E-06  ITERM=  2
NIT=   71  NFV=   71  NFG=   71  F= 0.233196848E-09  G= 0.100E-07  ITERM=  4
NIT=   40  NFV=   40  NFG=   40  F=  126.863549      G= 0.699E-08  ITERM=  4
NIT=  282  NFV=  282  NFG=  282  F= 0.732927514E-07  G= 0.400E-08  ITERM=  4
NIT=  344  NFV=  344  NFG=  344  F= 0.836329152E-08  G= 0.326E-08  ITERM=  4
NIT=  286  NFV=  287  NFG=  287  F=  2391.16999      G= 0.673E-04  ITERM=  2
NIT=  610  NFV=  611  NFG=  611  F= 0.317244739E-05  G= 0.548E-08  ITERM=  4
NIT= 2514  NFV= 2516  NFG= 2516  F=  552.380551      G= 0.448E-08  ITERM=  4
NIT=  907  NFV=  907  NFG=  907  F=  131.888476      G= 0.579E-08  ITERM=  4
NIT=  269  NFV=  271  NFG=  271  F= 0.173668302E-09  G= 0.266E-08  ITERM=  4
NIT= 1805  NFV= 1810  NFG= 1810  F=  621.128947      G= 0.906E-02  ITERM=  2
NIT=  680  NFV=  681  NFG=  681  F=  2940.50943      G= 0.140E-03  ITERM=  2
NIT=  370  NFV=  370  NFG=  370  F=  112.314954      G= 0.622E-08  ITERM=  4
NIT=  364  NFV=  364  NFG=  364  F=  36.0935676      G= 0.986E-08  ITERM=  4
NIT= 1004  NFV= 1004  NFG= 1004  F=  13.2000000      G= 0.904E-08  ITERM=  4
NIT=  380  NFV=  380  NFG=  380  F= 0.268534232E-01  G= 0.871E-09  ITERM=  4
NIT=15319  NFV=15321  NFG=15321  F= 0.589970806E-08  G= 0.925E-08  ITERM=  4
NIT= 3972  NFV= 4056  NFG= 4056  F= 0.565862690E-08  G= 0.887E-08  ITERM=  4
NIT=  774  NFV=  988  NFG=  988  F= 0.406495193E-08  G= 0.468E-08  ITERM=  4
NIT=  247  NFV=  248  NFG=  248  F=  264.000000      G= 0.364E-03  ITERM=  2
NIT= 1191  NFV= 1192  NFG= 1192  F=  593.360762      G= 0.145E-03  ITERM=  2
NITER =34839    NFVAL =35164    NSUCC =   22
TIME= 0:00:13.49


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 norm of gradient G and the cause of termination ITERM.

References:
-----------

[1] Luksan L., Matonoha C., Vlcek J.: LSA: Algorithms for large-scale
    unconstrained and box constrained optimization Technical Report V-896.
    Prague, ICS AS CR, 2004.

[2] Luksan L., Vlcek J.: Sparse and partially separable test problems
    for unconstrained and equality constrained optimization. Research
    Report V-767, Institute of Computer Science, Academy of Sciences
    of the Czech Republic, Prague, Czech Republic, 1998.

***********************************************************************
*                                                                     *
* PSUM - A PRIMAL INTERIOR-POINT VARIABLE METRIC AND DISCRETE NEWTON  *
*        METHODS WITH DIRECT DECOMPOSITION TRUST-REGION SUBALGORITHM  *
*        FOR MINIMIZING LARGE-SCALE SUMS OF ABSOLUTE VALUES.          *
*                                                                     *
***********************************************************************


1. Introduction:
----------------

      The double-precision FORTRAN 77 basic subroutine PSUM is designed
to find a close approximation to a local minimum of a sum of absolute
values

      F(X) =  |FA_1(X)| + |FA_2(X)| + ... + |FA_NA(X)|.

Here X is a vector of NF variables and FA_I(X), 1 <= I <= NA, are
twice continuously differentiable functions. We assume that NF and
NA are large, but partial functions FA_I(X), 1 <= I <= NA, depend
on a small number of variables. This implies that the mapping
AF(X) = [FA_1(X), FA_2(X), ..., FA_NA(X)] has a sparse Jacobian
matrix, which will be denoted by AG(X) (it has NA rows and NF
columns). The sparsity pattern of the Jacobian matrix is stored in
the coordinate form if ISPAS=1 or in the standard compressed row
format if ISPAS=2 using arrays IAG and JAG. For example, if the
Jacobian matrix has the following pattern

                AG = | * * 0 * |
                     | * * * 0 |
                     | * 0 0 * |
                     | 0 * * 0 |
                     | * 0 * 0 |

(asterisks denote nonzero elements) then arrays IAG and JAG contain
elements

IAG(1)=1, IAG(2)=1, IAG(3)=1, IAG(4)=2,  IAG(5)=2,  IAG(6)=2,
IAG(7)=3, IAG(8)=3, IAG(9)=4, IAG(10)=4, IAG(11)=5, IAG(12)=5,
JAG(1)=1, JAG(2)=2, JAG(3)=4, JAG(4)=1,  JAG(5)=2,  JAG(6)=3,
JAG(7)=1, JAG(8)=4, JAG(9)=2, JAG(10)=3, JAG(11)=1, JAG(12)=3

if ISPAS=1 or

IAG(1)=1, IAG(2)=4, IAG(3)=7, IAG(4)=9,  IAG(5)=11, IAG(6)=13,
JAG(1)=1, JAG(2)=2, JAG(3)=4, JAG(4)=1,  JAG(5)=2,  JAG(6)=3,
JAG(7)=1, JAG(8)=4, JAG(9)=2, JAG(10)=3, JAG(11)=1, JAG(12)=3

if ISPAS=2. In the first case, nonzero elements can be sorted in an
arbitrary order (not only by rows as in the above example). Arrays
IAG and JAG have to be declared with lengths NA+MA and MA at least,
respectively, where MA is the number of nonzero elements. In the
second case, nonzero elements can be sorted only by rows. Components
of IAG contain total numbers of nonzero elements in all previous
rows increased by 1 and elements of JAG contain corresponding column
indices (note that IAG has NA+1 elements and the last element is
equal to MA+1). Arrays IAG and JAG have to be declared with length
NA+1 and MA at least, respectively.
      To simplify user's work, an additional easy to use subroutine
PSUMU is added. It calls the basic general subroutine PSUM. All
subroutines contain a description of formal parameters and extensive
comments. Furthermore, test program TSUMU is included, which contains
several test problems (see e.g. [2]). This test program serves as an
example for using the subroutine PSUMU, verifies its correctness and
demonstrates its efficiency.
      In this short guide, we describe all subroutines which can be
called from the user's program. A detailed description of the method is
given in [1]. 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/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH

The arguments have the following meaning:

 Argument  Type Significance
 ----------------------------------------------------------------------
  NRES      O   Positive INTEGER variable that indicates the number of
                restarts.
  NDEC      O   Positive INTEGER variable that indicates the number of
                matrix decompositions.
  NIN       O   Positive INTEGER variable that indicates the number of
                inner iterations (for solving linear systems).
  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. Subroutine PSUMU:
--------------------

The calling sequence is

      CALL PSUMU(NF,NA,MA,X,AF,IAG,JAG,IPAR,RPAR,F,GMAX,ISPAS,IPRNT,ITERM)

The arguments have the following meaning.

 Argument  Type Significance
 ----------------------------------------------------------------------
  NF        I   Positive INTEGER variable that specifies the number of
                variables of the sum of absolute values.
  NA        I   Positive INTEGER variable that specifies the number of
                partial functions.
  MA        I   Number of nonzero elements in the Jacobian matrix. This
                parameter is used as input only if ISPAS=1 (it defines
                dimensions of arrays IAG and JAG in this case).
  X(NF)     U   On input, DOUBLE PRECISION vector with the initial
                estimate to the solution. On output, the approximation
                to the minimum.
  AF(NA)    O   DOUBLE PRECISION vector which contains values of partial
                functions.
  IAG(NA+1) I   INTEGER array which contains pointers of the first
                elements in rows of the Jacobian matrix.
  JAG(MA)   I   INTEGER array which contains column indices of the
                nonzero elements.
  IPAR(7)   I   INTEGER parameters:
                  IPAR(1)=MIT,  IPAR(2)=MFV,  IPAR(3)=MFG,
                  IPAR(4)=IEST, IPAR(5)=MED,  IPAR(6)-NONE,
                  IPAR(7)=IFIL.
                Parameters MIT, MFV, MFG, IEST, MED are described in
                Section 3 together with other parameters of the subroutine
                PSUM. Parameter IFIL specifies a relative size of the
                space reserved for fill-in. The choice IFIL=0 causes that
                the default value IFIL=1 will be taken.
  RPAR(9)   I   DOUBLE PRECISION parameters:
                  RPAR(1)=XMAX,  RPAR(2)=TOLX,  RPAR(3)=TOLF,
                  RPAR(4)=TOLB,  RPAR(5)=TOLG,  RPAR(6)=FMIN,
                  RPAR(7)=XDEL,  RPAR(8)-NONE,  RPAR(9)=ETA5.
                Parameters XMAX, TOLX, TOLF, TOLB, TOLG, FMIN, XDEL,
                ETA5 are described in Section 3 together with other
                parameters of the subroutine PSUM.
  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.
  ISPAS     I   INTEGER variable that specifies sparse structure of the
                Jacobian matrix:
                  ISPAS= 1 - the coordinate form is used,
                  ISPAS= 2 - the standard row compresed format is used.
  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.
  ITERM     O   INTEGER variable that indicates the cause of termination:
                  ITERM= 1 - if |X - XO| was less than or equal to TOLX
                             in two subsequent iterations,
                  ITERM= 2 - if |F - FO| was less than or equal to TOLF
                             in two 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= 6 - if termination criterion was not satisfied,
                             but the solution is probably acceptable,
                  ITERM=11 - if NIT exceeded MIT,
                  ITERM=12 - if NFV exceeded MFV,
                  ITERM=13 - if NFG exceeded MFG,
                  ITERM< 0 - if the method failed. Values ITERM<=-40
                             detect a lack of space. In this case,
                             parameter IPAR(7)=IFIL has to be increased
                             (IFIL=2, IFIL=3, etc.).

      The subroutine PSUMU requires the user supplied subroutines FUN and
DFUN that define partial functions and their gradients and have the form

      SUBROUTINE  FUN(NF,KA,X,FA)
      SUBROUTINE DFUN(NF,KA,X,GA)

The arguments of the 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   INTEGER index of the partial function.
  X(NF)     I   DOUBLE PRECISION an estimate to the solution.
  FA        O   DOUBLE PRECISION value of the KA-th partial function at
                the point X.
  GA(NF)    O   DOUBLE PRECISION gradient of the KA-th partial function
                at the point X. Note that only nonzero elements of this
                gradient have to be assigned.


3. Subroutine PSUM:
-------------------

      This general subroutine is called from all subroutines described
in Section 2. The calling sequence is

      CALL PSUM(NF,NA,MMAX,X,IX,AF,AFO,AG,AGO,GA,AH,AS,AZ,G,H,IH,JH,IA,
     & IAG,JAG,S,XO,GO,GS,COL,PSL,PERM,INVP,WN11,WN12,WN13,WN14,XMAX,
     & TOLX,TOLF,TOLB,TOLG,FMIN,XDEL,ETA5,GMAX,F,MIT,MFV,MFG,IEST,MED,
     & IPRNT,ITERM)

The arguments NF, NA, X, AF, IAG, JAG, GMAX, F, IPRNT, ITERM have the
same meaning as in Section 2. Other arguments have the following meaning:

 Argument  Type Significance
 ----------------------------------------------------------------------
  MMAX       I   INTEGER size of array H.
  IX(NF)     A   INTEGER auxiliary array.
  AFO(NA)    A   DOUBLE PRECISION auxiliary array.
  AG(MA)     A   DOUBLE PRECISION nonzero elements of the Jacobian
                 matrix
  AGO(MA)    A   DOUBLE PRECISION difference between the current and the
                 old Jacobian matrices. This array is used only if MED=1.
  GA(NF)     A   DOUBLE PRECISION gradient of the partial function.
  AH(MH)     A   DOUBLE PRECISION approximation of the partitioned
                 Hessian matrix. This array is used only if MED=1.
  AS(NA)     A   DOUBLE PRECISION vector of slack variables.
  AZ(NA)     A   DOUBLE PRECISION vector of Lagrange multipliers.
  G(NF)      A   DOUBLE PRECISION gradient of the objective function.
  H(MMAX)    A   DOUBLE PRECISION nonzero elements of the approximation
                 of the Hessian matrix and nonzero elements of the
                 Choleski factor.
  IH(NF+1)   I   INTEGER array which contains pointers of the diagonal
                 elements in the upper part of the Hessian matrix.
  JH(MMAX)   I   INTEGER array which contains column indices of the
                 nonzero elements and additional working space for the
                 Choleski factor.
  IA(NA)     A   INTEGER auxiliary array.
  S(NF)      A   DOUBLE PRECISION direction vector.
  XO(NF)     A   DOUBLE PRECISION array which contains increments of
                 variables.
  GO(NF)     A   DOUBLE PRECISION array which contains increments of
                 gradients.
  GS(NF)     A   DOUBLE PRECISION auxiliary array.
  COL(NF)    A   INTEGER auxiliary array.
  PSL(NF+1)  A   INTEGER pointer vector in the compact form of the
                 Choleski factor.
  PERM(NF)   A   INTEGER permutation vector.
  INVP(NF)   A   INTEGER inverse permutation vector.
  WN11(NF+1) A   INTEGER auxiliary array.
  WN12(NF+1) A   INTEGER auxiliary array.
  WN13(NF+1) A   INTEGER auxiliary array.
  WN14(NF+1) A   INTEGER auxiliary array.
  XMAX       I   DOUBLE PRECISION maximum stepsize; the choice XMAX=0
                 causes that the default value 1.0D+16 will be taken.
  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-12 will be taken.
  TOLB       I   DOUBLE PRECISION minimum acceptable function value;
                 the choice TOLB=0 causes that the default value
                 TOLB=FMIN+1.0D-12 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.
  FMIN       I   DOUBLE PRECISION lower bound for the minimum function
                 value.
  XDEL       I   DOUBLE PRECISION trust region stepsize; the choice
                 XDEL=0 causes that a suitable default value is
                 computed.
  ETA5       I   DOUBLE PRECISION minimum permitted value of the barrier
                 parameter; the choice ETA5=0 causes that the default
                 value ETA5=1.0D-8 will be taken.
  MIT        I   INTEGER variable that specifies the maximum number of
                 iterations; the choice MIT=0 causes that the default
                 value 5000 will be taken.
  MFV        I   INTEGER variable that specifies the maximum number of
                 function evaluations; the choice MFV=0 causes that
                 the default value 5000 will be taken.
  MFG        I   INTEGER variable that specifies the maximum number of
                 gradient evaluations; the choice MFG=0 causes that
                 the default value 10000 will be taken.
  IEST       I   INTEGER estimation of the minimum functiom value for
                 the line search:
                   IEST=0 - estimation is not used,
                   IEST=1 - lower bound FMIN is used as an estimation
                            for the minimum function value.
  MED        I   INTEGER variable that specifies the method used.
                   MED=1 - partitioned variable metric method,
                   MED=2 - safeguarded discrete Newton method.

The choice of parameter XMAX can be sensitive in many cases. First, the
objective function can be evaluated only in a relatively small region
(if it contains exponentials) so that the maximum stepsize is necessary.
Secondly, the problem can be very ill-conditioned far from the solution
point so that large steps can be unsuitable. Finally, if the problem has
more local solutions, a suitably chosen maximum stepsize can lead to
obtaining a better local solution. A suitable choice of parameter ETA5
(larger than 1.0d-8) can sometimes improve the efficiency of the method.
      The subroutine PSUM requires the user supplied subroutines FUN
and DFUN which are described in Section 2.

4. Verification of the subroutines:
-----------------------------------

      Subroutine PSUMU can be verified and tested using the program
TSUMU. This program calls the subroutines TIUB15 (initiation), TAFU15
(function evaluation) and TAGU15 (gradient evaluation) containing
22 unconstrained test problems with at most 200 variables [2]. The
results obtained by the program TSUMU on a PC computer with Microsoft
Power Station Fortran compiler have the following form.

NIT=  337  NFV=  355  NFG=  338  F= 0.193178806E-13  G= 0.254E-05  ITERM=  3
NIT=  127  NFV=  151  NFG=  128  F= 0.120336380E-12  G= 0.424E-05  ITERM=  3
NIT=   25  NFV=   28  NFG=   26  F= 0.383710546E-09  G= 0.331E-06  ITERM=  4
NIT=   67  NFV=   77  NFG=   68  F=  126.863549      G= 0.358E-02  ITERM=  2
NIT=    6  NFV=    7  NFG=    7  F= 0.494049246E-14  G= 0.666E-07  ITERM=  3
NIT=   13  NFV=   17  NFG=   14  F= 0.663150090E-13  G= 0.141E-06  ITERM=  3
NIT=   73  NFV=  108  NFG=   74  F=  2391.16999      G= 0.209E+00  ITERM=  2
NIT=  241  NFV=  243  NFG=  242  F= 0.383133726E-07  G= 0.708E-06  ITERM=  4
NIT=  209  NFV=  251  NFG=  209  F=  552.682636      G= 0.267E+01  ITERM= -6
NIT=   84  NFV=  106  NFG=   85  F=  131.888475      G= 0.242E-05  ITERM=  2
NIT=  732  NFV=  751  NFG=  733  F= 0.799693645E-12  G= 0.581E-05  ITERM=  3
NIT=  203  NFV=  237  NFG=  204  F=  612.723020      G= 0.601E-04  ITERM=  2
NIT=   90  NFV=  111  NFG=   91  F=  2940.50941      G= 0.245E-03  ITERM=  2
NIT=   84  NFV=  107  NFG=   85  F=  112.314955      G= 0.480E-05  ITERM=  2
NIT=   39  NFV=   64  NFG=   40  F=  36.0935678      G= 0.163E-01  ITERM=  2
NIT=   67  NFV=  108  NFG=   67  F=  13.2000005      G= 0.139E-03  ITERM=  6
NIT=  337  NFV=  344  NFG=  338  F= 0.100472795E-13  G= 0.167E-06  ITERM=  3
NIT= 3637  NFV= 3794  NFG= 3638  F= 0.199840144E-14  G= 0.419E-09  ITERM=  3
NIT=   23  NFV=   24  NFG=   24  F= 0.938360500E-12  G= 0.217E-04  ITERM=  3
NIT=   22  NFV=   44  NFG=   22  F= 0.121058719E-11  G= 0.398E-05  ITERM=  6
NIT=   65  NFV=   90  NFG=   66  F=  262.921649      G= 0.108E-05  ITERM=  2
NIT=  608  NFV=  627  NFG=  609  F=  593.367735      G= 0.525E-02  ITERM=  2
NITER = 7089    NFVAL = 7644    NSUCC =   21
TIME= 0:00:02.80

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 norm of gradient G and the cause of termination ITERM.

References:
-----------

[1] Luksan L., Matonoha C., Vlcek J.: LSA: Algorithms for large-scale
    unconstrained and box constrained optimization Technical Report V-896.
    Prague, ICS AS CR, 2004.

[2] Luksan L., Vlcek J.: Sparse and partially separable test problems
    for unconstrained and equality constrained optimization. Research
    Report V-767, Institute of Computer Science, Academy of Sciences
    of the Czech Republic, Prague, Czech Republic, 1998.

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!                                                                     !
!      SOURCE CODES                                                   !
!                                                                     !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!     
! SUBROUTINE PEQLU              ALL SYSTEMS                   97/01/22
! PURPOSE :
! EASY TO USE SUBROUTINE FOR SOLUTION OF SPARSE SYSTEMS OF NONLINEAR
! EQUATIONS USING THE LIMITED MEMORY INVERSE COLUMN UPDATE METHOD.
!
! PARAMETERS :
!  II  N  NUMBER OF VARIABLES.
!  RI  X(N)  VECTOR OF VARIABLES.
!  RO  AF(N)  VECTOR CONTAINING VALUES OF THE APPROXIMATED
!         FUNCTIONS.
!  II  IAG(N+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE JACOBIAN
!         MATRIX.
!  II  JAG(MA) COLUMN INDICES OF ELEMENTS IN THE JACOBIAN MATRIX.
!  II  IPAR(7)  INTEGER PAREMETERS:
!      IPAR(1)  MAXIMUM NUMBER OF ITERATIONS.
!      IPAR(2)  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!      IPAR(3)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PEQL.
!      IPAR(4)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PEQL.
!      IPAR(5)  CHOICE OF THE SMOOTHING STRATEGY FOR THE CONJUGATE
!         GRADIENT SQUARED METHOD. IPAR(5)=1-SMOOTHING IS NOT USED.
!         IPAR(5)=2-SINGLE SMOOTHING STRATEGY IS USED. IPAR(5)=3-DOUBLE
!         SMOOTHING STRATEGY IS USED.
!      IPAR(6)  CHOICE OF PRECONDITIONING. IPAR(6)=1-PRECONDITIONING
!         IS NOT USED. IPAR(6)=2-PRECONDITIONING BY THE INCOMPLETE
!         GILL-MURRAY DECOMPOSITION. IPAR(6)=3-PRECONDITIONING BY THE
!         INCOMPLETE GILL-MURRAY DECOMPOSITION WITH A PRELIMINARY
!         SOLUTION OF THE PRECONDITIONED SYSTEM WHICH IS USED IF IT
!         SATISFIES THE TERMINATION CRITERION.
!      IPAR(7)  MAXIMUM NUMBER OF QUASI-NEWTON UPDATES.
!  RI  RPAR(9)  REAL PARAMETERS:
!      RPAR(1)  MAXIMUM STEPSIZE.
!      RPAR(2)  TOLERANCE FOR THE CHANGE OF VARIABLES.
!      RPAR(3)  TOLERANCE FOR THE CHANGE OF FUNCTION VALUES.
!      RPAR(4)  TOLERANCE FOR THE FUNCTION FALUE.
!      RPAR(5)  TOLERANCE FOR THE GRADIENT NORM.
!      RPAR(6)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PEQN.
!      RPAR(7)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PEQN.
!      RPAR(8)  DAMPING PARAMETER FOR AN INCOMPLETE LU PRECONDITIONER.
!      RPAR(9)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PEQN.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  II  IDER  DEGREE OF ANALYTICALLY COMPUTED DERIVATIVES (0 OR 1).
!  II  ISPAS  INPUT SPARSE STRUCTURE. ISPAS=1-STANDARD COORDINATE
!         FORM. ISPAS=2-SPARSE STRUCTURE COMPRESSED BY ROWS.
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PEQL  SOLUTION OF SPARSE NONLINEAR SYSTEMS OF EQUATIONS BY THE
!         LIMITED MEMORY INVERSE COLUMN UPDATE METHOD USING THE
!         PRECONDITIONED SMOOTHED CGS METHOD FOR ITERATIVE SOLUTION OF
!         THE LINEARIZED SYSTEM.
!
! EXTERNAL SUBROUTINES :
!  SE  FUN  COMPUTATION OF THE VALUE OF THE APPROXIMATED FUNCTION.
!         CALLING SEQUENCE: CALL FUN(N,KA,X,FA) WHERE N IS A NUMBER
!         OF VARIALES, KA IS THE INDEX OF THE APPROXIMATED FUNCTION,
!         X(N) IS A VECTOR OF VARIABLES AND FA IS THE VALUE OF THE
!         APPROXIMATED FUNCTION.
!
      SUBROUTINE PEQLU (N, MA, X, AF, IAG, JAG, IPAR, RPAR, F, GMAX,
     &IDER, ISPAS, IPRNT, ITERM)
      DOUBLE PRECISION F,GMAX
      INTEGER IDER,ISPAS,IPRNT,ITERM,MA,N
      DOUBLE PRECISION AF(*),RPAR(9),X(*)
      INTEGER IAG(*),IPAR(7),JAG(*)
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      INTEGER LAFD,LAFO,LAG,LG,LGA,LGM,LGO,LGP,LGS,LIB,LIM,LIW1,LIW2,
     &LIW3,LIW4,LS,LXM,LXO,LXP,LXS,MF,IER
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      INTEGER IA(:)
      DOUBLE PRECISION RA(:)
      ALLOCATABLE IA,RA
      IF (ISPAS.LE.1) THEN
        CALL PASED3 (N, N, MA, IAG, JAG, IER)
        IF (IER.NE.0) THEN
          WRITE (6,'(''INPUT ERROR : IER = '',I3)') IER
          STOP
        END IF
      ELSE
        MA=IAG(N+1)-1
      END IF
      MF=IPAR(7)
      IF (MF.LE.0) MF=6
      ALLOCATE(IA(6*N),RA(11*N+2*MA+(N+1)*MF))
!
!     POINTERS FOR AUXILIARY ARRAYS
!
      LGA=1
      LAG=LGA+N
      LXM=LAG+2*MA
      LGM=LXM+N*MF
      LG=LGM+MF
      LS=LG+N
      LXO=LS+N
      LGO=LXO+N
      LXS=LGO+N
      LGS=LXS+N
      LXP=LGS+N
      LGP=LXP+N
      LAFO=LGP+N
      LAFD=LAFO+N
      LIB=1
      LIW1=LIB+N
      LIW2=LIW1+N
      LIW3=LIW2+N
      LIW4=LIW3+N
      LIM=LIW4+N
      CALL PEQL (N, X, RA(LGA), RA(LAG), IAG, JAG, IA(LIB), IA(LIW1),
     &IA(LIW2), IA(LIW3), IA(LIW4), RA(LXM), RA(LGM), IA(LIM), RA(LG),
     &RA(LS), RA(LXO), RA(LGO), RA(LXS), RA(LGS), RA(LXP), RA(LGP), AF,
     &RA(LAFO), RA(LAFD), RPAR(1), RPAR(2), RPAR(3), RPAR(4), RPAR(5),
     &RPAR(8), GMAX, F, IPAR(1), IPAR(2), IPAR(5), IPAR(6), MF, IDER,
     &IPRNT, ITERM)
      DEALLOCATE(IA,RA)
      RETURN
      END
! SUBROUTINE PEQL                   ALL SYSTEMS                95/12/01
! PORTABILITY : ALL SYSTEMS
! 95/12/01 LU : ORIGINAL VERSION
!
! PURPOSE :
! SOLUTION OF SPARSE NONLINEAR SYSTEMS OF EQUATIONS BY THE LIMITED
! MEMORY INVERSE COLUMN UPDATE METHOD USING THE PRECONDITIONED SMOOTHED
! CGS SUBALGORITHM FOR ITERATIVE SOLUTION OF LINEARIZED SYSTEMS.
!
! PARAMETERS :
!  II  N  NUMBER OF VARIABLES.
!  RI  X(N)  VECTOR OF VARIABLES.
!  RA  GA(N)  GRADIENT OF THE APPROXIMATED FUNCTION.
!  RA  AG(IAG(N+1)-1)  SPARSE RECTANGULAR MATRIX WHICH IS USED FOR THE
!         DIRECTION VECTOR DETERMINATION.
!  II  IAG(N+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
!  II  JAG(IAG(N+1)-1) COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
!  IA  IB(N)  PERMUTATION VECTOR.
!  IA  IW1(N)  AUXILIARY VECTOR.
!  IA  IW2(N)  AUXILIARY VECTOR.
!  IA  IW3(N)  AUXILIARY VECTOR.
!  IA  IW4(N)  AUXILIARY VECTOR.
!  RA  XM(N*MF)  SET OF VECTORS FOR INVERSE COLUMN UPDATE.
!  RA  GM(MF)  SET OF VALUES FOR INVERSE COLUMN UPDATE.
!  IA  IM(MF)  SET OF INDICES FOR INVERSE COLUMN UPDATE.
!  RA  G(N)  GRADIENT OF THE OBJECTIVE FUNCTION.
!  RA  S(N)  DIRECTION VECTOR.
!  RA  XO(N)  AUXILIARY VECTOR.
!  RA  GO(N)  AUXILIARY VECTOR.
!  RA  XS(N)  AUXILIARY VECTOR.
!  RA  GS(N)  AUXILIARY VECTOR.
!  RA  XP(N)  AUXILIARY VECTOR.
!  RA  GP(N)  AUXILIARY VECTOR.
!  RO  AF(N)  VECTOR WHOSE ELEMENTS ARE VALUES OF THE APPROXIMATED
!         FUNCTIONS.
!  RA  AFO(N)  AUXILIARY VECTOR.
!  RA  AFD(N)  AUXILIARY VECTOR.
!  RI  XMAX  MAXIMUM STEPSIZE.
!  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  ETA2  DAMPING PARAMETER FOR AN INCOMPLETE LU PRECONDITIONER.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  II  MIT  MAXIMUM NUMBER OF ITERATIONS.
!  II  MFV  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!  II  MOS1  CHOICE OF SMOOTHING STRATEGY FOR THE CGS METHOD.
!         MOS1=1-NO SMOOTHING. MOS1=2-SINGLE SMOOTHING STRATEGY
!         IS USED. MOS1=3-DOUBLE SMOOTHING STRATEGY IS USED.
!  II  MOS2  TYPE OF PRECONDITIONING. MOS2=1-PRECONDITIONING IS NOT
!         USED. MOS2=2-PRECONDITIONING BY THE INCOMPLETE GILL-MURRAY
!         DECOMPOSITION. MOS2=3-PRECONDITIONING BY THE INCOMPLETE
!         GILL-MURRAY DECOMPOSITION WITH A PRELIMINARY SOLUTION OF
!         THE PRECONDITIONED SYSTEM WHICH IS USED IF IT SATISFIES
!         THE TERMINATION CRITERION.
!  II  MF  MAXIMUM NUMBER OF INVERSE COLUMN UPDATES.
!  II  IDER  DEGREE OF ANALYTICALLY COMPUTED DERIVATIVES (0 OR 1).
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PA0SQ3  COMPUTATION OF THE VALUE AND THE GRADIENT OF THE
!         OBJECTIVE FUNCTION WHICH IS DEFINED AS A SUM OF SQUARES
!         OF THE APPROXIMATED FUNCTIONS (THE SPARSE CASE).
!  S   PS0L02  LINE SEARCH USING ONLY FUNCTION VALUES.
!  S   PYFUT1  TEST ON TERMINATION.
!  S   PULCI3  LIMITED MEMORY INVERSE COLUMN UPDATE.
!  S   MXDPGB  BACK SUBSTITUTION USING THE GILL-MURRAY DECOMPOSITION
!         OBTAINED BY MXDPGF.
!  S   MXDPGF  GILL-MURRAY DECOMPOSITION OF A DENSE SYMMETRIC MATRIX.
!  S   MXLIIM  MATRIX MULTIPLICATION FOR LIMITED STORAGE INVERSE COLUMN
!         UPDATE METHOD.
!  S   MXSCMM  MATRIX-VECTOR PRODUCT. SPARSE RECTANGULAR MATRIX IS
!         STORED COLUMNWISE.
!  S   MXSGIB  BACK SUBSTITUTION USING THE INCOMPLETE LU DECOMPOSITION
!         OBTAINED BY MXSGIF.
!  S   MXSGIF  INCOMPLETE LU DECOMPOSITION OF A SPARSE NONSYMMETRIC
!         MATRIX.
!  S   MXSRMD  MATRIX-VECTOR PRODUCT FOLLOWED BY THE ADDITION OF A
!         SCALED VECTOR. SPARSE RECTANGULAR MATRIX IS STORED ROWWISE.
!  S   MXSRMM  MATRIX-VECTOR PRODUCT. SPARSE RECTANGULAR MATRIX IS
!         STORED ROWWISE.
!  S   MXSRSP  ROW PERMUTATIONS FOR OBTAINING DIAGONAL NONZEROS.
!  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.
!  RF  MXVMAX  L-INFINITY NORM OF A VECTOR
!  S   MXVNEG  COPYING OF A VECTOR WITH CHANGE OF THE SIGN.
!  RF  MXVNOR  EUCLIDEAN NORM OF A VECTOR.
!  S   MXVSAV  DIFFERENCE OF TWO VECTORS WITH COPYING AND SAVING THE
!         SUBSTRACTED ONE.
!  S   MXVSET  INITIATION OF A VECTOR.
!  S   MXVSUM  SUM OF TWO VECTORS.
!
! EXTERNAL SUBROUTINES :
!  SE  FUN  COMPUTATION OF THE VALUE OF THE APPROXIMATED FUNCTION.
!         CALLING SEQUENCE: CALL FUN(N,KA,X,FA) WHERE N IS A NUMBER
!         OF VARIABLES, KA IS THE INDEX OF THE APPROXIMATED FUNCTION,
!         X(N) IS A VECTOR OF VARIABLES AND FA IS THE VALUE OF THE
!         APPROXIMATED FUNCTION.
!
! METHOD :
! PRECONDITIONED SMOOTHED CGS METHOD WITH INEXACT TERMINATION.
!
      SUBROUTINE PEQL (N, X, GA, AG, IAG, JAG, IB, IW1, IW2, IW3, IW4,
     &XM, GM, IM, G, S, XO, GO, XS, GS, XP, GP, AF, AFO, AFD, XMAX,
     &TOLX, TOLF, TOLB, TOLG, ETA2, GMAX, F, MIT, MFV, MOS1, MOS2, MF,
     &IDER, IPRNT, ITERM)
      DOUBLE PRECISION ETA2,F,GMAX,TOLB,TOLD,TOLF,TOLG,TOLS,TOLX,XMAX
      INTEGER IDER,IPRNT,ITERM,MES,MF,MFV,MIT,MOS,MOS1,MOS2,N
      DOUBLE PRECISION AF(*),AFD(*),AFO(*),AG(*),G(*),GA(*),GM(*),GO(*),
     &GP(*),GS(*),S(*),X(*),XM(*),XO(*),XP(*),XS(*)
      INTEGER IAG(*),IB(*),IM(*),IW1(*),IW2(*),IW3(*),IW4(*),JAG(*)
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      DOUBLE PRECISION ALF1,ALF2,DMAX,EPS6,ETA0,ETA9,FMAX,FMIN,FO,FP,
     &GNORM,P,PO,PP,R,RMAX,RMIN,RO,RP,SNORM,BTB(3),BTR(2),RMU,RNU,ALF,
     &BET,SIG,RHO,RHO1,RHO2,PAR,UMAX
      INTEGER I,INF,IPOM1,IPOM2,IREST,ITERD,ITERH,ITERS,NRED,KD,KIT,LD,
     &MA,MRED,MTESF,MTESX,NTESF,NTESX,LDS,IDECA,INITS,KTERS,IEST,ITES,
     &MAXST,IRES1,IRES2,MM,ISYS,MFG
      DOUBLE PRECISION MXVDOT,MXVNOR,MXVMAX
      EXTERNAL MXVDOT,MXVNOR,MXVMAX
      EXTERNAL PA0SQ3,PS0L02,PULCI3,MXSRSP,MXVCOP,MXVDIF
      INTRINSIC  ABS,MAX,MIN,SQRT
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      IF (ABS(IPRNT).GT.1) WRITE (6,'(1X,''ENTRY TO PEQL :'')')
!
!     INITIATION
!
      NRES=0
      NDEC=0
      NIN=0
      NIT=0
      NFV=0
      NFG=0
      NFH=0
      ISYS=0
      IEST=1
      ITES=1
      MTESX=2
      MTESF=2
      INITS=1
      ITERM=0
      ITERD=0
      ITERS=2
      ITERH=0
      KTERS=5
      IREST=1
      IRES1=999
      IRES2=0
      MRED=20
      IDECA=0
      IPOM1=0
      IPOM2=1
      ETA0=1.0D-15
      IF (ETA2.LE.0.0D0.OR.ETA2.GE.1.0D0) ETA2=0.0D0
      ETA9=1.0D120
      EPS6=2.5D-1
      ALF1=1.0D-15
      ALF2=1.0D10
      FMAX=1.0D60
      FMIN=0.0D0
      IF (XMAX.LE.0.0D0) XMAX=1.0D16
      IF (TOLX.LE.0.0D0) TOLX=1.0D-16
      IF (TOLF.LE.0.0D0) TOLF=1.0D-16
      IF (TOLB.LE.0.0D0) TOLB=1.0D-16
      IF (TOLG.LE.0.0D0) TOLG=1.0D-6
      TOLD=1.0D-12
      TOLS=1.0D-4
      MES=1
      MOS=2
      IF (MOS1.LE.0) MOS1=3
      IF (MOS2.EQ.0) MOS2=3
      IDER=MAX(IDER,0)
      IF (MIT.LE.0) MIT=1000
      IF (MFV.LE.0) MFV=1000
      MFG=MFV
      KD=0
      LD=-1
      KIT=0
      FO=FMIN
      GMAX=ETA9
      DMAX=ETA9
!
!     SYMBOLIC PREPATION OF INCOMPLETE LU DECOMPOSITION
!
      MA=IAG(N+1)-1
      IF (MOS2.GT.1) CALL MXSRSP (N, IAG, JAG, IB, INF, IW1, IW2, IW3,
     &IW4)
!
!     COMPUTATION OF THE VALUE OF THE OBJECTIVE FUNCTION
!
      CALL PA0SQ3 (N, X, F, AF, GA, AG, IAG, JAG, G, ETA0, KD, LD, NFV,
     &NFG, IDER)
   10 IF (ABS(IPRNT).GT.1) WRITE (6,'(1X,''NIT='',I5,2X,''NFV='',I5,2X,'
     &'NFG='',I5,2X,       ''F='', G13.6,2X,''G='',G13.6)') NIT,NFV,NFG,
     &F,GNORM
!
!     START OF THE ITERATION WITH TESTS FOR TERMINATION.
!
      CALL PYFUT1 (N, F, FO, UMAX, GMAX, DMAX, TOLX, TOLF, TOLB, TOLG,
     &KD, NIT, KIT, MIT, NFV, MFV, NFG, MFG, NTESX, MTESX, NTESF, MTESF,
     & ITES, IRES1, IRES2, IREST, ITERS, ITERM)
      IF (ITERM.NE.0) GO TO 100
   20 MRED=10
      IF (IREST.LE.0) MRED=5
      IF (IREST.LE.0) GO TO 30
!
!     RESTART
!
      KD=1
      CALL PA0SQ3 (N, X, F, AF, GA, AG, IAG, JAG, G, ETA0, KD, LD, NFV,
     &NFG, IDER)
      IDECA=0
      IF (KIT.LT.NIT) THEN
        NRES=NRES+1
        KIT=NIT
      ELSE
        ITERM=-10
        IF (ITERS.LT.0) ITERM=ITERS-5
      END IF
   30 CONTINUE
      IF (ITERM.NE.0) GO TO 100
!
!     DIRECTION DETERMINATION USING PRECONDITIONED SMOOTHED CGS
!     ALGORITHM
!
      MM=NIT-KIT
      IF (MM.EQ.0) THEN
        IF (MOS2.GT.1) THEN
!
!     CONSTRUCTION OF PRECONDITIONER
!
          INF=0
          CALL MXVCOP (MA, AG, AG(MA+1))
          CALL MXSGIF (N, AG(MA+1), IAG, JAG, IB, IW1, IW2, ETA2, INF)
          IF (INF.LT.0) THEN
            ITERD=INF
            GO TO 60
          ELSE
            NDEC=NDEC+1
            IDECA=2
          END IF
        END IF
      ELSE
        CALL MXLIIM (N, MM, AG(MA+1), IAG, JAG, IB, IW1, XM, GM, IM, AF,
     &    S, XO)
        CALL MXVNEG (N, S, S)
        ITERD=1
        SNORM=SQRT(MXVDOT(N,S,S))
        GNORM=SNORM
        GO TO 50
      END IF
      IF (MOS.EQ.1) THEN
        IF (LD.LE.0) CALL MXSCMM (N, N, AG, IAG, JAG, AF, G)
      ELSE
        CALL MXVCOP (N, AF, G)
      END IF
      GNORM=SQRT(MXVDOT(N,G,G))
      PAR=SQRT(F/FO)**1.618D0
      PAR=MAX(PAR,SQRT(SQRT(2.0D0*F)))
      PAR=MIN(EPS6,PAR)
      IF (PAR.GT.1.0D1*1.0D-3) THEN
        PAR=MIN(PAR,1.0D0/DBLE(NIT))
      END IF
      PAR=PAR*PAR
      RHO2=MXVDOT(N,AF,AF)
      IF (MOS2.GT.2) THEN
!
!     PRELIMINARY INEXACT SOLUTION
!
        CALL MXVNEG (N, AF, S)
        CALL MXSGIB (N, AG(MA+1), IAG, JAG, IB, IW1, S, XO, 0)
        CALL MXSRMD (N, AG, IAG, JAG, S, 1.0D0, AF, AFO)
        RHO1=MXVDOT(N,AFO,AFO)
        IF (RHO1.LE.PAR*RHO2) THEN
          SNORM=SQRT(MXVDOT(N,S,S))
          ITERD=1
          GO TO 50
        END IF
      END IF
      ITERD=2
!
!     CGS INITIATION
!
      SNORM=0.0D0
      RHO=1.0D0
      CALL MXVNEG (N, AF, AFO)
      CALL MXVNEG (N, AF, AFD)
      CALL MXVSET (N, 0.0D0, S)
      CALL MXVSET (N, 0.0D0, XO)
      CALL MXVSET (N, 0.0D0, GO)
      CALL MXVSET (N, 0.0D0, XS)
      SIG=MXVNOR(N,AFD)
!
!    CGS ITERATIONS
!
      DO 40 NRED=1,2*N
        RHO1=RHO
        IF (RHO1.EQ.0.0D0) THEN
          ITERD=-4
          GO TO 60
        END IF
        RHO=MXVDOT(N,G,AFD)
        BET=RHO/RHO1
        CALL MXVDIR (N, BET, XS, AFD, GS)
        CALL MXVDIR (N, BET, GO, XS, GO)
        CALL MXVDIR (N, BET, GO, GS, GO)
!
!     CGS PRECONDITIONING
!
        CALL MXVCOP (N, GO, GA)
        IF (MOS2.GT.1) CALL MXSGIB (N, AG(MA+1), IAG, JAG, IB, IW1, GA,
     &   XP, 0)
        CALL MXSRMM (N, AG, IAG, JAG, GA, XP)
        SIG=MXVDOT(N,G,XP)
        IF (SIG.EQ.0.0D0) THEN
          ITERD=-5
          GO TO 60
        END IF
        ALF=RHO/SIG
!
!     CGS STEP
!
        CALL MXVDIR (N, -ALF, XP, GS, XS)
        CALL MXVSUM (N, GS, XS, GS)
!
!     CGS PRECONDITIONING
!
        IF (MOS2.GT.1) CALL MXSGIB (N, AG(MA+1), IAG, JAG, IB, IW1, GS,
     &   GP, 0)
        CALL MXSRMM (N, AG, IAG, JAG, GS, GP)
!
!     CGS STEP
!
        CALL MXVDIR (N, -ALF, GP, AFD, AFD)
        CALL MXVDIR (N, ALF, GS, XO, XO)
        NIN=NIN+1
!
!     CGS SMOOTHING
!
        IF (MOS1.EQ.1) THEN
          CALL MXVCOP (N, AFD, AFO)
          CALL MXVCOP (N, XO, S)
        ELSE
          RMU=ETA0**2
          CALL MXVDIF (N, AFO, AFD, GP)
          BTB(1)=MXVDOT(N,GP,GP)
          BTR(1)=MXVDOT(N,GP,AFD)
          IF (MOS1.EQ.3) THEN
            BTB(2)=MXVDOT(N,GP,XP)
            BTB(3)=MXVDOT(N,XP,XP)
            BTR(2)=MXVDOT(N,XP,AFD)
            CALL MXDPGF (2, BTB, INF, RMU, RNU)
            CALL MXDPGB (2, BTB, BTR, 0)
            RMU=-BTR(1)
            RNU=-BTR(2)
          ELSE
            RMU=-BTR(1)/MAX(BTB(1),RMU)
          END IF
          CALL MXVDIR (N, RMU, GP, AFD, AFO)
          CALL MXVDIF (N, S, XO, GP)
          CALL MXVDIR (N, RMU, GP, XO, S)
          IF (MOS1.EQ.3) THEN
            CALL MXVDIR (N, RNU, XP, AFO, AFO)
            CALL MXVDIR (N, -RNU, GA, S, S)
          END IF
        END IF
        SNORM=MXVNOR(N,S)
        IF (SNORM.GE.XMAX) GO TO 50
        RHO1=MXVDOT(N,AFO,AFO)
        IF (RHO1.LE.PAR*RHO2) GO TO 50
   40 CONTINUE
!
!     AN INEXACT SOLUTION IS OBTAINED
!
   50 CONTINUE
      P=-F
   60 CONTINUE
      IF (ITERD.LT.0) THEN
        ITERM=ITERD
      ELSE
!
!     TEST FOR SUFFICIENT DESCENT
!
        IF (SNORM.LE.0.0D0) THEN
          IREST=MAX(IREST,1)
        ELSE IF (P+TOLD*GNORM*SNORM.LE.0.0D0) THEN
          IREST=0
        ELSE
!
!     UNIFORM DESCENT CRITERION
!
          IREST=MAX(IREST,1)
        END IF
        IF (IREST.EQ.0) THEN
!
!     PREPARATION OF LINE SEARCH
!
          NRED=0
          RMIN=ALF1*GNORM/SNORM
          RMAX=MIN(ALF2*GNORM/SNORM,XMAX/SNORM)
        END IF
      END IF
      IF (ITERM.NE.0) GO TO 100
      IF (IREST.NE.0) GO TO 20
      LDS=LD
      FP=FO
      RO=0.0D0
      FO=F
      PO=P
      CALL MXVCOP (N, X, XO)
      CALL MXVCOP (N, AF, AFO)
   70 CALL PS0L02 (R, RO, RP, F, FO, FP, PO, PP, FMIN, FMAX, RMIN, RMAX,
     & TOLS, KD, LD, NIT, KIT, NRED, MRED, MAXST, IEST, INITS, ITERS,
     &KTERS, MES, ISYS)
      IF (ISYS.EQ.0) GO TO 80
      CALL MXVDIR (N, R, S, XO, X)
      CALL PA0SQ3 (N, X, F, AF, GA, AG, IAG, JAG, G, ETA0, KD, LD, NFV,
     &NFG, IDER)
      GO TO 70
   80 CONTINUE
      IF (ITERS.LE.0) THEN
        R=0.0D0
        F=FO
        P=PO
        CALL MXVCOP (N, XO, X)
        CALL MXVCOP (N, AFO, AF)
        IREST=MAX(IREST,1)
        LD=LDS
        GO TO 20
      END IF
      IREST=1
      IF (NRED.LE.0) THEN
        IPOM1=2
        IREST=0
      ELSE
        IPOM1=0
      END IF
      IF (IPOM1.EQ.1) KD=1
      IF (KD.GT.LD) THEN
        CALL PA0SQ3 (N, X, F, AF, GA, AG, IAG, JAG, G, ETA0, KD, LD,
     &   NFV, NFG, IDER)
      END IF
      KD=0
      IF (ITERS.GT.0) THEN
        CALL MXVDIF (N, X, XO, XO)
        PO=R*PO
        P=R*P
      ELSE
        F=FO
        P=PO
        CALL MXVSAV (N, X, XO)
        LD=KD
      END IF
      DMAX=0.0D0
      DO 90 I=1,N
        DMAX=MAX(DMAX,ABS(XO(I))/MAX(ABS(X(I)),1.0D0))
   90 CONTINUE
      IF (IPOM1.EQ.2) THEN
        IF (ITERS.GT.0) THEN
          CALL MXVDIF (N, AF, AFO, AFO)
        ELSE
          CALL MXVSAV (N, AF, AFO)
        END IF
        CALL PULCI3 (N, AG, IAG, JAG, IB, IW1, XM, GM, IM, XO, AFO, S,
     &   MF, NIT, KIT, ITERH, IREST)
      END IF
      IF (ITERH.NE.0) IREST=MAX(IREST,1)
      GO TO 10
  100 CONTINUE
      IF (IPRNT.GT.1.OR.IPRNT.LT.0) WRITE (6,'(1X,''EXIT FROM PEQL :'')'
     &)
      IF (IPRNT.NE.0) THEN
        GMAX=MXVMAX(N,G)
        WRITE (6,'(1X,''NIT='',I5,2X,''NFV='',I5,2X,''NFG='',I5,2X,
     &   ''F='', G13.6,2X,''G='',G13.6,2X,''ITERM='',I3)') NIT,NFV,NFG,
     &   F,GMAX,ITERM
      END IF
      IF (IPRNT.LT.0) WRITE (6,'(1X,''X='',5(G14.7,1X):/(3X,5(G14.7,1X))
     &)') (X(I),I=1,N)
      RETURN
      END
! SUBROUTINE PEQNU              ALL SYSTEMS                   97/01/22
! PURPOSE :
! EASY TO USE SUBROUTINE FOR SOLUTION OF SPARSE SYSTEMS OF NONLINEAR
! EQUATIONS USING THE DISCRETE NEWTON METHOD.
!
! PARAMETERS :
!  II  N  NUMBER OF VARIABLES.
!  RI  X(N)  VECTOR OF VARIABLES.
!  RO  AF(N)  VECTOR CONTAINING VALUES OF THE APPROXIMATED
!         FUNCTIONS.
!  II  IAG(N+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE JACOBIAN
!         MATRIX.
!  II  JAG(MA) COLUMN INDICES OF ELEMENTS IN THE JACOBIAN MATRIX.
!  II  IPAR(7)  INTEGER PAREMETERS:
!      IPAR(1)  MAXIMUM NUMBER OF ITERATIONS.
!      IPAR(2)  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!      IPAR(3)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PEQN.
!      IPAR(4)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PEQN.
!      IPAR(5)  CHOICE OF THE SMOOTHING STRATEGY FOR THE CONJUGATE
!         GRADIENT SQUARED METHOD. IPAR(5)=1-SMOOTHING IS NOT USED.
!         IPAR(5)=2-SINGLE SMOOTHING STRATEGY IS USED. IPAR(5)=3-DOUBLE
!         SMOOTHING STRATEGY IS USED.
!      IPAR(6)  CHOICE OF PRECONDITIONING. IPAR(6)=1-PRECONDITIONING
!         IS NOT USED. IPAR(6)=2-PRECONDITIONING BY THE INCOMPLETE
!         GILL-MURRAY DECOMPOSITION. IPAR(6)=3-PRECONDITIONING BY THE
!         INCOMPLETE GILL-MURRAY DECOMPOSITION WITH A PRELIMINARY
!         SOLUTION OF THE PRECONDITIONED SYSTEM WHICH IS USED IF IT
!         SATISFIES THE TERMINATION CRITERION.
!      IPAR(7)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PEQN.
!  RI  RPAR(9)  REAL PARAMETERS:
!      RPAR(1)  MAXIMUM STEPSIZE.
!      RPAR(2)  TOLERANCE FOR THE CHANGE OF VARIABLES.
!      RPAR(3)  TOLERANCE FOR THE CHANGE OF FUNCTION VALUES.
!      RPAR(4)  TOLERANCE FOR THE FUNCTION FALUE.
!      RPAR(5)  TOLERANCE FOR THE GRADIENT NORM.
!      RPAR(6)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PEQN.
!      RPAR(7)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PEQN.
!      RPAR(8)  DAMPING PARAMETER FOR AN INCOMPLETE LU PRECONDITIONER.
!      RPAR(9)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PEQN.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  II  IDER  DEGREE OF ANALYTICALLY COMPUTED DERIVATIVES (0 OR 1).
!  II  ISPAS  INPUT SPARSE STRUCTURE. ISPAS=1-STANDARD COORDINATE
!         FORM. ISPAS=2-SPARSE STRUCTURE COMPRESSED BY ROWS.
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PEQN  SOLUTION OF SPARSE NONLINEAR SYSTEMS OF EQUATIONS BY THE
!         NEWTON METHOD USING THE PRECONDITIONED SMOOTHED CGS METHOD
!         FOR ITERATIVE SOLUTION OF THE LINEARIZED SYSTEM.
!
! EXTERNAL SUBROUTINES :
!  SE  FUN  COMPUTATION OF THE VALUE OF THE APPROXIMATED FUNCTION.
!         CALLING SEQUENCE: CALL FUN(N,KA,X,FA) WHERE N IS A NUMBER
!         OF VARIALES, KA IS THE INDEX OF THE APPROXIMATED FUNCTION,
!         X(N) IS A VECTOR OF VARIABLES AND FA IS THE VALUE OF THE
!         APPROXIMATED FUNCTION.
!
      SUBROUTINE PEQNU (N, MA, X, AF, IAG, JAG, IPAR, RPAR, F, GMAX,
     &IDER, ISPAS, IPRNT, ITERM)
      DOUBLE PRECISION F,GMAX
      INTEGER IDER,ISPAS,IPRNT,ITERM,MA,N
      DOUBLE PRECISION AF(*),RPAR(9),X(*)
      INTEGER IAG(*),IPAR(7),JAG(*)
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      INTEGER LAFD,LAFO,LAG,LG,LGA,LGO,LGP,LGS,LIB,LIW1,LIW2,LIW3,LIW4,
     &LS,LXO,LXP,LXS,IER
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      INTEGER IA(:)
      DOUBLE PRECISION RA(:)
      ALLOCATABLE IA,RA
      IF (ISPAS.LE.1) THEN
        CALL PASED3 (N, N, MA, IAG, JAG, IER)
        IF (IER.NE.0) THEN
          WRITE (6,'(''INPUT ERROR : IER = '',I3)') IER
          STOP
        END IF
      ELSE
        MA=IAG(N+1)-1
      END IF
      ALLOCATE(IA(5*N),RA(11*N+2*MA))
!
!     POINTERS FOR AUXILIARY ARRAYS
!
      LGA=1
      LAG=LGA+N
      LG=LAG+2*MA
      LS=LG+N
      LXO=LS+N
      LGO=LXO+N
      LXS=LGO+N
      LGS=LXS+N
      LXP=LGS+N
      LGP=LXP+N
      LAFO=LGP+N
      LAFD=LAFO+N
      LIB=1
      LIW1=LIB+N
      LIW2=LIW1+N
      LIW3=LIW2+N
      LIW4=LIW3+N
      CALL PEQN (N, X, RA(LGA), RA(LAG), IAG, JAG, IA(LIB), IA(LIW1),
     &IA(LIW2), IA(LIW3), IA(LIW4), RA(LG), RA(LS), RA(LXO), RA(LGO),
     &RA(LXS), RA(LGS), RA(LXP), RA(LGP), AF, RA(LAFO), RA(LAFD),
     &RPAR(1), RPAR(2), RPAR(3), RPAR(4), RPAR(5), RPAR(8), GMAX, F,
     &IPAR(1), IPAR(2), IPAR(5), IPAR(6), IDER, IPRNT, ITERM)
      DEALLOCATE(IA,RA)
      RETURN
      END
! SUBROUTINE PEQN                   ALL SYSTEMS                95/12/01
! PORTABILITY : ALL SYSTEMS
! 95/12/01 LU : ORIGINAL VERSION
!
! PURPOSE :
! SOLUTION OF SPARSE NONLINEAR SYSTEMS OF EQUATIONS BY THE NEWTON
! METHOD USING THE PRECONDITIONED SMOOTHED CGS SUBALGORITHM FOR
! ITERATIVE SOLUTION OF LINEARIZED SYSTEMS.
!
! PARAMETERS :
!  II  N  NUMBER OF VARIABLES.
!  RI  X(N)  VECTOR OF VARIABLES.
!  RA  GA(N)  GRADIENT OF THE APPROXIMATED FUNCTION.
!  RA  AG(IAG(N+1)-1)  SPARSE RECTANGULAR MATRIX WHICH IS USED FOR THE
!         DIRECTION VECTOR DETERMINATION.
!  II  IAG(N+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
!  II  JAG(IAG(N+1)-1) COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
!  IA  IB(N)  PERMUTATION VECTOR.
!  IA  IW1(N)  AUXILIARY VECTOR.
!  IA  IW2(N)  AUXILIARY VECTOR.
!  IA  IW3(N)  AUXILIARY VECTOR.
!  IA  IW4(N)  AUXILIARY VECTOR.
!  RA  G(N)  GRADIENT OF THE OBJECTIVE FUNCTION.
!  RA  S(N)  DIRECTION VECTOR.
!  RA  XO(N)  AUXILIARY VECTOR.
!  RA  GO(N)  AUXILIARY VECTOR.
!  RA  XS(N)  AUXILIARY VECTOR.
!  RA  GS(N)  AUXILIARY VECTOR.
!  RA  XP(N)  AUXILIARY VECTOR.
!  RA  GP(N)  AUXILIARY VECTOR.
!  RO  AF(N)  VECTOR WHOSE ELEMENTS ARE VALUES OF THE APPROXIMATED
!         FUNCTIONS.
!  RA  AFO(N)  AUXILIARY VECTOR.
!  RA  AFD(N)  AUXILIARY VECTOR.
!  RI  XMAX  MAXIMUM STEPSIZE.
!  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  ETA2  DAMPING PARAMETER FOR AN INCOMPLETE LU PRECONDITIONER.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  II  MIT  MAXIMUM NUMBER OF ITERATIONS.
!  II  MFV  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!  II  MOS1  CHOICE OF SMOOTHING STRATEGY FOR THE CGS METHOD.
!         MOS1=1-NO SMOOTHING. MOS1=2-SINGLE SMOOTHING STRATEGY
!         IS USED. MOS1=3-DOUBLE SMOOTHING STRATEGY IS USED.
!  II  MOS2  TYPE OF PRECONDITIONING. MOS2=1-PRECONDITIONING IS NOT
!         USED. MOS2=2-PRECONDITIONING BY THE INCOMPLETE GILL-MURRAY
!         DECOMPOSITION. MOS2=3-PRECONDITIONING BY THE INCOMPLETE
!         GILL-MURRAY DECOMPOSITION WITH A PRELIMINARY SOLUTION OF
!         THE PRECONDITIONED SYSTEM WHICH IS USED IF IT SATISFIES
!         THE TERMINATION CRITERION.
!  II  IDER  DEGREE OF ANALYTICALLY COMPUTED DERIVATIVES (0 OR 1).
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PA0SQ3  COMPUTATION OF THE VALUE AND THE GRADIENT OF THE
!         OBJECTIVE FUNCTION WHICH IS DEFINED AS A SUM OF SQUARES
!         OF THE APPROXIMATED FUNCTIONS (THE SPARSE CASE).
!  S   PS0L02  LINE SEARCH USING ONLY FUNCTION VALUES.
!  S   PYFUT1  TEST ON TERMINATION.
!  S   MXDPGB  BACK SUBSTITUTION USING THE GILL-MURRAY DECOMPOSITION
!         OBTAINED BY MXDPGF.
!  S   MXDPGF  GILL-MURRAY DECOMPOSITION OF A DENSE SYMMETRIC MATRIX.
!  S   MXSCMM  MATRIX-VECTOR PRODUCT. SPARSE RECTANGULAR MATRIX IS
!         STORED COLUMNWISE.
!  S   MXSGIB  BACK SUBSTITUTION USING THE INCOMPLETE LU DECOMPOSITION
!         OBTAINED BY MXSGIF.
!  S   MXSGIF  INCOMPLETE LU DECOMPOSITION OF A SPARSE NONSYMMETRIC
!         MATRIX.
!  S   MXSRMD  MATRIX-VECTOR PRODUCT FOLLOWED BY THE ADDITION OF A
!         SCALED VECTOR. SPARSE RECTANGULAR MATRIX IS STORED ROWWISE.
!  S   MXSRMM  MATRIX-VECTOR PRODUCT. SPARSE RECTANGULAR MATRIX IS
!         STORED ROWWISE.
!  S   MXSRSP  ROW PERMUTATIONS FOR OBTAINING DIAGONAL NONZEROS.
!  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.
!  RF  MXVMAX  L-INFINITY NORM OF A VECTOR
!  S   MXVNEG  COPYING OF A VECTOR WITH CHANGE OF THE SIGN.
!  RF  MXVNOR  EUCLIDEAN NORM OF A VECTOR.
!  S   MXVSAV  DIFFERENCE OF TWO VECTORS WITH COPYING AND SAVING THE
!         SUBSTRACTED ONE.
!  S   MXVSET  INITIATION OF A VECTOR.
!  S   MXVSUM  SUM OF TWO VECTORS.
!
! EXTERNAL SUBROUTINES :
!  SE  FUN  COMPUTATION OF THE VALUE OF THE APPROXIMATED FUNCTION.
!         CALLING SEQUENCE: CALL FUN(N,KA,X,FA) WHERE N IS A NUMBER
!         OF VARIABLES, KA IS THE INDEX OF THE APPROXIMATED FUNCTION,
!         X(N) IS A VECTOR OF VARIABLES AND FA IS THE VALUE OF THE
!         APPROXIMATED FUNCTION.
!
! METHOD :
! PRECONDITIONED SMOOTHED CGS METHOD WITH INEXACT TERMINATION.
!
      SUBROUTINE PEQN (N, X, GA, AG, IAG, JAG, IB, IW1, IW2, IW3, IW4,
     &G, S, XO, GO, XS, GS, XP, GP, AF, AFO, AFD, XMAX, TOLX, TOLF,
     &TOLB, TOLG, ETA2, GMAX, F, MIT, MFV, MOS1, MOS2, IDER, IPRNT,
     &ITERM)
      DOUBLE PRECISION ETA2,F,GMAX,TOLB,TOLD,TOLF,TOLG,TOLS,TOLX,XMAX
      INTEGER IDER,IPRNT,ITERM,MES,MFV,MIT,MOS,MOS1,MOS2,N
      DOUBLE PRECISION AF(*),AFD(*),AFO(*),AG(*),G(*),GA(*),GO(*),GP(*),
     &GS(*),S(*),X(*),XO(*),XP(*),XS(*)
      INTEGER IAG(*),IB(*),IW1(*),IW2(*),IW3(*),IW4(*),JAG(*)
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      DOUBLE PRECISION ALF1,ALF2,DMAX,EPS6,ETA0,ETA9,FMAX,FMIN,FO,FP,
     &GNORM,P,PO,PP,R,RMAX,RMIN,RO,RP,SNORM,BTB(3),BTR(2),RMU,RNU,ALF,
     &BET,SIG,RHO,RHO1,RHO2,PAR,UMAX
      INTEGER I,INF,IPOM1,IPOM2,IREST,ITERD,ITERS,NRED,KD,KIT,LD,MA,
     &MRED,MTESF,MTESX,NTESF,NTESX,LDS,IDECA,INITS,KTERS,IEST,ITES,
     &MAXST,IRES1,IRES2,ISYS,MFG
      DOUBLE PRECISION MXVDOT,MXVNOR,MXVMAX
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      IF (ABS(IPRNT).GT.1) WRITE (6,'(1X,''ENTRY TO PEQN :'')')
!
!     INITIATION
!
      NRES=0
      NDEC=0
      NIN=0
      NIT=0
      NFV=0
      NFG=0
      NFH=0
      ISYS=0
      IEST=1
      ITES=1
      MTESX=2
      MTESF=2
      INITS=1
      ITERM=0
      ITERD=0
      ITERS=2
      KTERS=5
      IREST=1
      IRES1=999
      IRES2=0
      MRED=20
      IDECA=0
      IPOM1=0
      IPOM2=0
      ETA0=1.0D-15
      IF (ETA2.LE.0.0D0.OR.ETA2.GE.1.0D0) ETA2=0.0D0
      ETA9=1.0D120
      EPS6=2.5D-1
      ALF1=1.0D-15
      ALF2=1.0D10
      FMAX=1.0D60
      FMIN=0.0D0
      IF (XMAX.LE.0.0D0) XMAX=1.0D16
      IF (TOLX.LE.0.0D0) TOLX=1.0D-16
      IF (TOLF.LE.0.0D0) TOLF=1.0D-16
      IF (TOLB.LE.0.0D0) TOLB=1.0D-16
      IF (TOLG.LE.0.0D0) TOLG=1.0D-6
      TOLD=1.0D-12
      TOLS=1.0D-4
      MES=1
      MOS=1
      IF (MOS1.LE.0) MOS1=3
      IF (MOS2.EQ.0) MOS2=3
      IDER=MAX(IDER,0)
      IF (MIT.LE.0) MIT=1000
      IF (MFV.LE.0) MFV=1000
      MFG=MFV
      KD=0
      LD=-1
      KIT=0
      FO=FMIN
      GMAX=ETA9
      DMAX=ETA9
!
!     SYMBOLIC PREPATION OF INCOMPLETE LU DECOMPOSITION
!
      MA=IAG(N+1)-1
      IF (MOS2.GT.1) CALL MXSRSP (N, IAG, JAG, IB, INF, IW1, IW2, IW3,
     &IW4)
!
!     COMPUTATION OF THE VALUE OF THE OBJECTIVE FUNCTION
!
      CALL PA0SQ3 (N, X, F, AF, GA, AG, IAG, JAG, G, ETA0, KD, LD, NFV,
     &NFG, IDER)
   10 IF (ABS(IPRNT).GT.1) WRITE (6,'(1X,''NIT='',I5,2X,''NFV='',I5,2X,'
     &'NFG='',I5,2X,       ''F='', G13.6,2X,''G='',G13.6)') NIT,NFV,NFG,
     &F,GNORM
!
!     START OF THE ITERATION WITH TESTS FOR TERMINATION.
!
      CALL PYFUT1 (N, F, FO, UMAX, GMAX, DMAX, TOLX, TOLF, TOLB, TOLG,
     &KD, NIT, KIT, MIT, NFV, MFV, NFG, MFG, NTESX, MTESX, NTESF, MTESF,
     & ITES, IRES1, IRES2, IREST, ITERS, ITERM)
      IF (ITERM.NE.0) GO TO 100
   20 IF (IREST.LE.0) GO TO 30
!
!     RESTART
!
      KD=1
      CALL PA0SQ3 (N, X, F, AF, GA, AG, IAG, JAG, G, ETA0, KD, LD, NFV,
     &NFG, IDER)
      IDECA=0
      IF (KIT.LT.NIT) THEN
        NRES=NRES+1
        KIT=NIT
      ELSE
        ITERM=-10
        IF (ITERS.LT.0) ITERM=ITERS-5
      END IF
   30 CONTINUE
      IF (ITERM.NE.0) GO TO 100
!
!     DIRECTION DETERMINATION USING PRECONDITIONED SMOOTHED CGS
!     ALGORITHM
!
      IF (IDECA.LT.0) IDECA=0
      IF (IDECA.EQ.2) THEN
      ELSE IF (IDECA.NE.0) THEN
        ITERD=-1
        GO TO 60
      ELSE IF (MOS2.GT.1) THEN
!
!     CONSTRUCTION OF PRECONDITIONER
!
        INF=0
        CALL MXVCOP (MA, AG, AG(MA+1))
        CALL MXSGIF (N, AG(MA+1), IAG, JAG, IB, IW1, IW2, ETA2, INF)
        IF (INF.LT.0) THEN
          ITERD=INF
          GO TO 60
        ELSE
          NDEC=NDEC+1
          IDECA=2
        END IF
      END IF
      IF (MOS.EQ.1) THEN
        IF (LD.LE.0) CALL MXSCMM (N, N, AG, IAG, JAG, AF, G)
      ELSE
        CALL MXVCOP (N, AF, G)
      END IF
      GNORM=SQRT(MXVDOT(N,G,G))
      PAR=SQRT(F/FO)**1.618D0
      PAR=MAX(PAR,SQRT(SQRT(2.0D0*F)))
      PAR=MIN(EPS6,PAR)
      IF (PAR.GT.1.0D1*1.0D-3) THEN
        PAR=MIN(PAR,1.0D0/DBLE(NIT))
      END IF
      PAR=PAR*PAR
      RHO2=MXVDOT(N,AF,AF)
      IF (MOS2.GT.2) THEN
!
!     PRELIMINARY INEXACT SOLUTION
!
        CALL MXVNEG (N, AF, S)
        CALL MXSGIB (N, AG(MA+1), IAG, JAG, IB, IW1, S, XO, 0)
        CALL MXSRMD (N, AG, IAG, JAG, S, 1.0D0, AF, AFO)
        RHO1=MXVDOT(N,AFO,AFO)
        IF (RHO1.LE.PAR*RHO2) THEN
          SNORM=SQRT(MXVDOT(N,S,S))
          ITERD=1
          GO TO 50
        END IF
      END IF
      ITERD=2
!
!     CGS INITIATION
!
      SNORM=0.0D0
      RHO=1.0D0
      CALL MXVNEG (N, AF, AFO)
      CALL MXVNEG (N, AF, AFD)
      CALL MXVSET (N, 0.0D0, S)
      CALL MXVSET (N, 0.0D0, XO)
      CALL MXVSET (N, 0.0D0, GO)
      CALL MXVSET (N, 0.0D0, XS)
      SIG=MXVNOR(N,AFD)
      NRED=0
!
!    CGS ITERATIONS
!
      DO 40 NRED=1,2*N
        RHO1=RHO
        IF (RHO1.EQ.0.0D0) THEN
          ITERD=-4
          GO TO 60
        END IF
        RHO=MXVDOT(N,G,AFD)
        BET=RHO/RHO1
        CALL MXVDIR (N, BET, XS, AFD, GS)
        CALL MXVDIR (N, BET, GO, XS, GO)
        CALL MXVDIR (N, BET, GO, GS, GO)
!
!     CGS PRECONDITIONING
!
        CALL MXVCOP (N, GO, GA)
        IF (MOS2.GT.1) CALL MXSGIB (N, AG(MA+1), IAG, JAG, IB, IW1, GA,
     &   XP, 0)
        CALL MXSRMM (N, AG, IAG, JAG, GA, XP)
        SIG=MXVDOT(N,G,XP)
        IF (SIG.EQ.0.0D0) THEN
          ITERD=-5
          GO TO 60
        END IF
        ALF=RHO/SIG
!
!     CGS STEP
!
        CALL MXVDIR (N, -ALF, XP, GS, XS)
        CALL MXVSUM (N, GS, XS, GS)
!
!     CGS PRECONDITIONING
!
        IF (MOS2.GT.1) CALL MXSGIB (N, AG(MA+1), IAG, JAG, IB, IW1, GS,
     &   GP, 0)
        CALL MXSRMM (N, AG, IAG, JAG, GS, GP)
!
!     CGS STEP
!
        CALL MXVDIR (N, -ALF, GP, AFD, AFD)
        CALL MXVDIR (N, ALF, GS, XO, XO)
        NIN=NIN+1
!
!     CGS SMOOTHING
!
        IF (MOS1.EQ.1) THEN
          CALL MXVCOP (N, AFD, AFO)
          CALL MXVCOP (N, XO, S)
        ELSE
          RMU=ETA0**2
          CALL MXVDIF (N, AFO, AFD, GP)
          BTB(1)=MXVDOT(N,GP,GP)
          BTR(1)=MXVDOT(N,GP,AFD)
          IF (MOS1.EQ.3) THEN
            BTB(2)=MXVDOT(N,GP,XP)
            BTB(3)=MXVDOT(N,XP,XP)
            BTR(2)=MXVDOT(N,XP,AFD)
            CALL MXDPGF (2, BTB, INF, RMU, RNU)
            CALL MXDPGB (2, BTB, BTR, 0)
            RMU=-BTR(1)
            RNU=-BTR(2)
          ELSE
            RMU=-BTR(1)/MAX(BTB(1),RMU)
          END IF
          CALL MXVDIR (N, RMU, GP, AFD, AFO)
          CALL MXVDIF (N, S, XO, GP)
          CALL MXVDIR (N, RMU, GP, XO, S)
          IF (MOS1.EQ.3) THEN
            CALL MXVDIR (N, RNU, XP, AFO, AFO)
            CALL MXVDIR (N, -RNU, GA, S, S)
          END IF
        END IF
        SNORM=MXVNOR(N,S)
        IF (SNORM.GE.XMAX) GO TO 50
        RHO1=MXVDOT(N,AFO,AFO)
        IF (RHO1.LE.PAR*RHO2) GO TO 50
   40 CONTINUE
!
!     AN INEXACT SOLUTION IS OBTAINED
!
   50 CONTINUE
      P=-F
   60 CONTINUE
      IF (ITERD.LT.0) THEN
        ITERM=ITERD
      ELSE
!
!     TEST FOR SUFFICIENT DESCENT
!
        IF (SNORM.LE.0.0D0) THEN
          IREST=MAX(IREST,1)
        ELSE IF (P+TOLD*GNORM*SNORM.LE.0.0D0) THEN
          IREST=0
        ELSE
!
!     UNIFORM DESCENT CRITERION
!
          IREST=MAX(IREST,1)
        END IF
        IF (IREST.EQ.0) THEN
!
!     PREPARATION OF LINE SEARCH
!
          NRED=0
          RMIN=ALF1*GNORM/SNORM
          RMAX=MIN(ALF2*GNORM/SNORM,XMAX/SNORM)
        END IF
      END IF
      IF (ITERM.NE.0) GO TO 100
      IF (IREST.NE.0) GO TO 20
      LDS=LD
      FP=FO
      RO=0.0D0
      FO=F
      PO=P
      CALL MXVCOP (N, X, XO)
      CALL MXVCOP (N, AF, AFO)
   70 CALL PS0L02 (R, RO, RP, F, FO, FP, PO, PP, FMIN, FMAX, RMIN, RMAX,
     & TOLS, KD, LD, NIT, KIT, NRED, MRED, MAXST, IEST, INITS, ITERS,
     &KTERS, MES, ISYS)
      IF (ISYS.EQ.0) GO TO 80
      CALL MXVDIR (N, R, S, XO, X)
      CALL PA0SQ3 (N, X, F, AF, GA, AG, IAG, JAG, G, ETA0, KD, LD, NFV,
     &NFG, IDER)
      GO TO 70
   80 CONTINUE
      IF (ITERS.LE.0) THEN
        R=0.0D0
        F=FO
        P=PO
        CALL MXVCOP (N, XO, X)
        CALL MXVCOP (N, AFO, AF)
        IREST=MAX(IREST,1)
        LD=LDS
        GO TO 20
      END IF
      IF (IPOM1.EQ.1) KD=1
      IF (KD.GT.LD) THEN
        CALL PA0SQ3 (N, X, F, AF, GA, AG, IAG, JAG, G, ETA0, KD, LD,
     &   NFV, NFG, IDER)
      END IF
      KD=0
      IREST=1
      IF (ITERS.GT.0) THEN
        CALL MXVDIF (N, X, XO, XO)
        PO=R*PO
        P=R*P
      ELSE
        F=FO
        P=PO
        CALL MXVSAV (N, X, XO)
        LD=KD
      END IF
      DMAX=0.0D0
      DO 90 I=1,N
        DMAX=MAX(DMAX,ABS(XO(I))/MAX(ABS(X(I)),1.0D0))
   90 CONTINUE
      GO TO 10
  100 CONTINUE
      IF (IPRNT.GT.1.OR.IPRNT.LT.0) WRITE (6,'(1X,''EXIT FROM PEQN :'')'
     &)
      IF (IPRNT.NE.0) THEN
        GMAX=MXVMAX(N,G)
        WRITE (6,'(1X,''NIT='',I5,2X,''NFV='',I5,2X,''NFG='',I5,2X,
     &   ''F='', G13.6,2X,''G='',G13.6,2X,''ITERM='',I3)') NIT,NFV,NFG,
     &   F,GMAX,ITERM
      END IF
      IF (IPRNT.LT.0) WRITE (6,'(1X,''X='',5(G14.7,1X):/(3X,5(G14.7,1X))
     &)') (X(I),I=1,N)
      RETURN
      END
! SUBROUTINE PGACU              ALL SYSTEMS                   97/01/22
! PURPOSE :
! EASY TO USE SUBROUTINE FOR LARGE-SCALE UNCONSTRAINED LEAST-SQUARES
! PROBLEMS WITH SPARSE JACOBIAN MATRICES.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  II  NA  NUMBER OF APPROXIMATED FUNCTIONS.
!  IU  MA  NUMBER OF NONZERO ELEMENTS IN THE JACOBIAN MATRIX.
!  RI  X(NF)  VECTOR OF VARIABLES.
!  RO  AF(NA)  VECTOR CONTAINING VALUES OF THE APPROXIMATED
!         FUNCTIONS.
!  RI  IAG(NA+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE JACOBIAN
!         MATRIX.
!  RI  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE JACOBIAN MATRIX.
!  II  IPAR(7)  INTEGER PAREMETERS:
!      IPAR(1)  MAXIMUM NUMBER OF ITERATIONS.
!      IPAR(2)  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!      IPAR(3)  MAXIMUM NUMBER OF GRADIENT EVALUATIONS.
!      IPAR(4)  TYPE OF THE SECOND ORDER CORRECTION. MET=1-THE MARWIL
!         SPARSE VARIABLE METRIC UPDATE. MET=2-THE NEWTON CORRECTION
!         BY USING GRADIENT DIFFERENCES. MET=3-THE PARTITIONED VARIABLE
!         METRIC UPDATE.
!      IPAR(5)  METHOD FOR COMPUTING A TRUST REGION STEP. IPAR(5)=1-THE
!         STEIHAUG-TOINT METHOD. IPAR(5)=2-THE SHIFTED STEIHAUG-TOINT
!         METHOD WITH FIVE LANCZOS STEPS. IPAR(5)>2-THE SHIFTED
!         STEIHAUG-TOINT METHOD WITH IPAR(5) LANCZOS STEPS.
!      IPAR(6)  TYPE OF PRECONDITIONING. IPAR(6)=1-PRECONDITIONING IS
!         NOT USED. IPAR(6)=2-PRECONDITIONING BY THE INCOMPLETE
!         GILL-MURRAY DECOMPOSITION. IPAR(6)=3-PRECONDITIONING BY THE
!         INCOMPLETE GILL-MURRAY DECOMPOSITION WITH A PRELIMINARY
!         SOLUTION OF THE PRECONDITIONED SYSTEM WHICH IS USED IF IT
!         SATISFIES THE TERMINATION CRITERION.
!      IPAR(7)  NUMBER DEFINING THE SPACE FOR FILL-IN (THE SIZE OF THIS
!         SPACE IS IFIL TIMES THE STANDARD SIZE). THE DEFAULT VALUE IS
!         IFIL=1. THE DEFAULT VALUE HAS TO BE INCREASED IF ITERM IS
!         LESS OR EQUAL TO -40.
!  RI  RPAR(9)  REAL PARAMETERS:
!      RPAR(1)  MAXIMUM STEPSIZE.
!      RPAR(2)  TOLERANCE FOR THE CHANGE OF VARIABLES.
!      RPAR(3)  TOLERANCE FOR THE CHANGE OF FUNCTION VALUES.
!      RPAR(4)  TOLERANCE FOR THE FUNCTION FALUE.
!      RPAR(5)  TOLERANCE FOR THE GRADIENT NORM.
!      RPAR(6)  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!      RPAR(7)  INITIAL TRUST-REGION RADIUS.
!      RPAR(8)  TOLERANCE FOR THE SWITCH BETWEEN THE GAUSS-NEWTON AND
!      RPAR(9)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PNED.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  II  IDER  DEGREE OF ANALYTICALLY COMPUTED DERIVATIVES (0 OR 1).
!  II  ISPAS  INPUT SPARSE STRUCTURE. ISPAS=1-STANDARD COORDINATE
!         FORM. ISPAS=2-SPARSE STRUCTURE COMPRESSED BY ROWS.
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!         VALUES ITERM<=-40 DETECT A LACK OF SPACE. IN THIS CASE,
!         PARAMETER IPAR(7) HAS TO BE INCREASED.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PGAC  HYBRID METHOD FOR SPARSE LEAST SQUARES PROBLEMS.
!  S   PASED3  COMPRESSED SPARSE STRUCTURE OF THE JACOBIAN MATRIX IS
!         COMPUTED FROM THE COORDINATE FORM.
!  S   PFSET2  NUMBER OF NONZERO ELEMENTS IN THE PARTITIONED HESSIAN
!         MATRIX.
!
! EXTERNAL SUBROUTINES :
!  SE  FUN  COMPUTATION 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  DFUN  COMPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION.
!         CALLING SEQUENCE: CALL DFUN(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 PGACU (NF, NA, MA, X, AF, IAG, JAG, IPAR, RPAR, F,
     &GMAX, IDER, ISPAS, IPRNT, ITERM)
      INTEGER NF,NA,MA,IAG(*),JAG(*),IPAR(7),IDER,ISPAS,IPRNT,ITERM
      DOUBLE PRECISION X(*),AF(*),RPAR(9),F,GMAX
      INTEGER NB,LGA,LAG,LG,LHA,LAH,LH,LS,LXO,LGO,LAGO,LXS,LGS,LIH,LJH,
     &LIW,ML,MH,IFIL,IER
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      INTEGER IA(:)
      DOUBLE PRECISION RA(:)
      ALLOCATABLE IA,RA
      IFIL=IPAR(7)
      IF (IFIL.LE.0) IFIL=1
      IF (ISPAS.LE.1) THEN
        CALL PASED3 (NF, NA, MA, IAG, JAG, IER)
        IF (IER.NE.0) THEN
          WRITE (6,'(''INPUT ERROR : IER = '',I3)') IER
          STOP
        END IF
      ELSE
        MA=IAG(NA+1)-1
      END IF
      CALL PFSET2 (NA, MH, ML, IAG)
      ALLOCATE(IA(2*NF+1+(IFIL+2)*MH))
      IF (IPAR(4).LE.2) THEN
        ALLOCATE(RA(7*NF+ML+(IFIL+2)*MH))
      ELSE
        ALLOCATE(RA(7*NF+2*MA+ML+(IFIL+3)*MH))
      END IF
      NB=0
!
!     POINTERS FOR AUXILIARY ARRAYS
!
      LGA=1
      LG=LGA+NF
      LS=LG+NF
      LXO=LS+NF
      LGO=LXO+NF
      LXS=LGO+NF
      LGS=LXS+NF
      IF (IPAR(4).LE.2) THEN
        LAG=LGS
        LAGO=LGS
        LAH=LGS
        LHA=LGS+NF
      ELSE
        LAG=LGS+NF
        LAGO=LAG+MA
        LAH=LAGO+MA
        LHA=LAH+MH
      END IF
      LH=LHA+ML
      LIH=1
      LIW=LIH+NF+1
      LJH=LIW+NF+1
      CALL PGAC (NF, NA, NB, (IFIL+2)*MH, X, IA, RA, RA, AF, RA(LGA),
     &RA(LAG), RA(LG), RA(LHA), RA(LAH), RA(LH), IA(LIH), IA(LJH), IAG,
     &JAG, RA(LS), RA(LXO), RA(LGO), RA(LAGO), RA(LXS), RA(LGS), IA(LIW)
     &, RPAR(1), RPAR(2), RPAR(3), RPAR(4), RPAR(5), RPAR(6), RPAR(7),
     &RPAR(8), GMAX, F, IPAR(1), IPAR(2), IPAR(3), IPAR(4), IPAR(5),
     &IPAR(6), IDER, IPRNT, ITERM)
      DEALLOCATE(IA,RA)
      RETURN
      END
! SUBROUTINE PGACS              ALL SYSTEMS                   97/01/22
! PURPOSE :
! EASY TO USE SUBROUTINE FOR LARGE-SCALE BOX CONSTRAINED LEAST-SQUARES
! PROBLEMS WITH SPARSE JACOBIAN MATRICES.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  II  NA  NUMBER OF LINEAR APPROXIMATED FUNCTIONS.
!  IU  MA  NUMBER OF NONZERO ELEMENTS IN THE JACOBIAN MATRIX.
!  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-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  AF(NA)  VECTOR CONTAINING VALUES OF THE APPROXIMATED
!         FUNCTIONS.
!  RI  IAG(NA+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE JACOBIAN
!         MATRIX.
!  RI  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE JACOBIAN MATRIX.
!  II  IPAR(7)  INTEGER PAREMETERS:
!      IPAR(1)  MAXIMUM NUMBER OF ITERATIONS.
!      IPAR(2)  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!      IPAR(3)  MAXIMUM NUMBER OF GRADIENT EVALUATIONS.
!      IPAR(4)  TYPE OF THE SECOND ORDER CORRECTION. MET=1-THE MARWIL
!         SPARSE VARIABLE METRIC UPDATE. MET=2-THE NEWTON CORRECTION
!         BY USING GRADIENT DIFFERENCES. MET=3-THE PARTITIONED VARIABLE
!         METRIC UPDATE.
!      IPAR(5)  METHOD FOR COMPUTING A TRUST REGION STEP. IPAR(5)=1-THE
!         STEIHAUG-TOINT METHOD. IPAR(5)=2-THE SHIFTED STEIHAUG-TOINT
!         METHOD WITH FIVE LANCZOS STEPS. IPAR(5)>2-THE SHIFTED
!         STEIHAUG-TOINT METHOD WITH IPAR(5) LANCZOS STEPS.
!      IPAR(6)  TYPE OF PRECONDITIONING. IPAR(6)=1-PRECONDITIONING IS
!         NOT USED. IPAR(6)=2-PRECONDITIONING BY THE INCOMPLETE
!         GILL-MURRAY DECOMPOSITION. IPAR(6)=3-PRECONDITIONING BY THE
!         INCOMPLETE GILL-MURRAY DECOMPOSITION WITH A PRELIMINARY
!         SOLUTION OF THE PRECONDITIONED SYSTEM WHICH IS USED IF IT
!         SATISFIES THE TERMINATION CRITERION.
!      IPAR(7)  NUMBER DEFINING THE SPACE FOR FILL-IN (THE SIZE OF THIS
!         SPACE IS IFIL TIMES THE STANDARD SIZE). THE DEFAULT VALUE IS
!         IFIL=1. THE DEFAULT VALUE HAS TO BE INCREASED IF ITERM IS
!         LESS OR EQUAL TO -40.
!  RI  RPAR(9)  REAL PARAMETERS:
!      RPAR(1)  MAXIMUM STEPSIZE.
!      RPAR(2)  TOLERANCE FOR THE CHANGE OF VARIABLES.
!      RPAR(3)  TOLERANCE FOR THE CHANGE OF FUNCTION VALUES.
!      RPAR(4)  TOLERANCE FOR THE FUNCTION FALUE.
!      RPAR(5)  TOLERANCE FOR THE GRADIENT NORM.
!      RPAR(6)  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!      RPAR(7)  INITIAL TRUST-REGION RADIUS.
!      RPAR(8)  TOLERANCE FOR THE SWITCH BETWEEN THE GAUSS-NEWTON AND
!      RPAR(9)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PNED.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  II  IDER  DEGREE OF ANALYTICALLY COMPUTED DERIVATIVES (0 OR 1).
!  II  ISPAS  INPUT SPARSE STRUCTURE. ISPAS=1-STANDARD COORDINATE
!         FORM. ISPAS=2-SPARSE STRUCTURE COMPRESSED BY ROWS.
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!         VALUES ITERM<=-40 DETECT A LACK OF SPACE. IN THIS CASE,
!         PARAMETER IPAR(7) HAS TO BE INCREASED.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PGAC  HYBRID METHOD FOR SPARSE LEAST SQUARES PROBLEMS.
!  S   PASED3  COMPRESSED SPARSE STRUCTURE OF THE JACOBIAN MATRIX IS
!         COMPUTED FROM THE COORDINATE FORM.
!  S   PFSET2  NUMBER OF NONZERO ELEMENTS IN THE PARTITIONED HESSIAN
!         MATRIX.
!
! EXTERNAL SUBROUTINES :
!  SE  FUN  COMPUTATION 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  DFUN  COMPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION.
!         CALLING SEQUENCE: CALL DFUN(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 PGACS (NF, NA, MA, X, IX, XL, XU, AF, IAG, JAG, IPAR,
     &RPAR, F, GMAX, IDER, ISPAS, IPRNT, ITERM)
      INTEGER NF,NA,MA,IX(*),IAG(*),JAG(*),IPAR(7),IDER,ISPAS,IPRNT,
     &ITERM
      DOUBLE PRECISION X(*),XL(*),XU(*),AF(*),RPAR(9),F,GMAX
      INTEGER NB,LGA,LG,LAG,LHA,LAH,LH,LS,LXO,LGO,LAGO,LXS,LGS,LIH,LJH,
     &LIW,ML,MH,IFIL,IER
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      INTEGER IA(:)
      DOUBLE PRECISION RA(:)
      ALLOCATABLE IA,RA
      IFIL=IPAR(7)
      IF (IFIL.LE.0) IFIL=1
      IF (ISPAS.LE.1) THEN
        CALL PASED3 (NF, NA, MA, IAG, JAG, IER)
        IF (IER.NE.0) THEN
          WRITE (6,'(''INPUT ERROR : IER = '',I3)') IER
          STOP
        END IF
      ELSE
        MA=IAG(NA+1)-1
      END IF
      CALL PFSET2 (NA, MH, ML, IAG)
      ALLOCATE(IA(2*NF+1+(IFIL+2)*MH))
      IF (IPAR(4).LE.2) THEN
        ALLOCATE(RA(7*NF+ML+(IFIL+2)*MH))
      ELSE
        ALLOCATE(RA(7*NF+2*MA+ML+(IFIL+3)*MH))
      END IF
      NB=1
!
!     POINTERS FOR AUXILIARY ARRAYS
!
      LGA=1
      LG=LGA+NF
      LS=LG+NF
      LXO=LS+NF
      LGO=LXO+NF
      LXS=LGO+NF
      LGS=LXS+NF
      IF (IPAR(4).LE.2) THEN
        LAG=LGS
        LAGO=LGS
        LAH=LGS
        LHA=LGS+NF
      ELSE
        LAG=LGS+NF
        LAGO=LAG+MA
        LAH=LAGO+MA
        LHA=LAH+MH
      END IF
      LH=LHA+ML
      LIH=1
      LIW=LIH+NF+1
      LJH=LIW+NF+1
      CALL PGAC (NF, NA, NB, (IFIL+2)*MH, X, IX, XL, XU, AF, RA(LGA),
     &RA(LAG), RA(LG), RA(LHA), RA(LAH), RA(LH), IA(LIH), IA(LJH), IAG,
     &JAG, RA(LS), RA(LXO), RA(LGO), RA(LAGO), RA(LXS), RA(LGS), IA(LIW)
     &, RPAR(1), RPAR(2), RPAR(3), RPAR(4), RPAR(5), RPAR(6), RPAR(7),
     &RPAR(8), GMAX, F, IPAR(1), IPAR(2), IPAR(3), IPAR(4), IPAR(5),
     &IPAR(6), IDER, IPRNT, ITERM)
      DEALLOCATE(IA,RA)
      RETURN
      END
! SUBROUTINE PGAC               ALL SYSTEMS                   01/09/22
! PURPOSE :
! GENERAL SUBROUTINE FOR LARGE-SCALE BOX CONSTRAINED LEAST-SQUARES
! PROBLEMS WITH SPARSE JACOBIAN MATRICES.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  II  NA  NUMBER OF APPROXIMATING FUNCTIONS.
!  II  NB  CHOICE OF SIMPLE BOUNDS. NB=0-SIMPLE BOUNDS SUPPRESSED.
!         NB>0-SIMPLE BOUNDS ACCEPTED.
!  II  MMAX  MAXIMUM DIMENSION OF THE SPARSE TABLEAU.
!  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-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  AF(NA)  VECTOR CONTAINING VALUES OF THE APPROXIMATED
!         FUNCTIONS.
!  RA  GA(NF)  GRADIENT OF THE SELECTED APPROXIMATING FUNCTION.
!  RA  AG(MA)  JACOBIAN MATRIX OF APPROXIMATING FUNCTIONS.
!  RU  G(NF)  GRADIENT OF THE OBJECTIVE FUNCTION.
!  RA  HA(ML)  HESSIAN MATRIX OF THE SELECTED APPROXIMATING FUNCTION.
!  RA  AH(MH)  ELEMENTS OF THE PARTITIONED HESSIAN MATRIX.
!  RA  H(MMAX)  NONZERO ELEMENTS OF THE SPARSE HESSIAN MATRIX WITH
!         AN ADDITIONAL SPACE USED FOR THE NUMERICAL DIFFERENTIATION.
!  II  IH(NF+1)  POINTERS OF DIAGONAL ELEMENTS OF THE MATRIX H.
!  IU  JH(MMAX)  INDICES OF NONZERO ELEMENTS OF THE MATRIX H
!         TOGETHER WITH AN ADDITIONAL SPACE USED FOR THE NUMERICAL
!         DIFFERENTIATION.
!  RI  IAG(NA+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
!  RI  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
!  RU  S(NF)  DIRECTION VECTOR.
!  RU  XO(NF)  VECTORS OF VARIABLES DIFFERENCE.
!  RU  GO(NF)  GRADIENTS DIFFERENCE.
!  RA  AGO(MA)  OLD JACOBIAN MATRIX OF THE PARTITIONED FUNCTION,
!  RA  XS(NF)  AUXILIARY VECTOR.
!  RA  GS(NF)  AUXILIARY VECTOR.
!  IA  IW(NF+1) AUXILIARY VECTOR.
!  RI  XMAX  MAXIMUM STEPSIZE.
!  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 NORM.
!  RI  FMIN  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!  RI  XDEL  TRUST REGION STEPSIZE.
!  RI  ETA   TOLERANCE FOR THE SWITCH BETWEEN THE GAUSS-NEWTON AND
!         THE MARWIL METHODS.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  II  MIT  MAXIMUM NUMBER OF ITERATIONS.
!  II  MFV  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!  II  MFG  MAXIMUM NUMBER OF GRADIENT EVALUATIONS.
!  II  MEC  TYPE OF THE SECOND ORDER CORRECTION. MEC=1-THE MARWIL
!         SPARSE VARIABLE METRIC UPDATE. MEC=2-THE NEWTON CORRECTION
!         BY USING GRADIENT DIFFERENCES. MEC=3-THE PARTITIONED
!         VARIABLE METRIC UPDATE.
!  II  MOS1  METHOD FOR COMPUTING A TRUST REGION STEP. MOS1=1-THE
!         STEIHAUG-TOINT METHOD. MOS1=2-THE SHIFTED STEIHAUG-TOINT
!         METHOD WITH FIVE LANCZOS STEPS. MOS1>2-THE SHIFTED
!         STEIHAUG-TOINT METHOD WITH MOS1 LANCZOS STEPS.
!  II  MOS2  TYPE OF PRECONDITIONING. MOS2=1-PRECONDITIONING IS NOT
!         USED. MOS2=2-PRECONDITIONING BY THE INCOMPLETE GILL-MURRAY
!         DECOMPOSITION. MOS2=3-PRECONDITIONING BY THE INCOMPLETE
!         GILL-MURRAY DECOMPOSITION WITH A PRELIMINARY SOLUTION OF
!         THE PRECONDITIONED SYSTEM WHICH IS USED IF IT SATISFIES
!         THE TERMINATION CRITERION.
!  II  IDER  DEGREE OF ANALYTICALLY COMPUTED DERIVATIVES (0 OR 1).
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!         VALUES ITERM<=-40 DETECT A LACK OF SPACE.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PA2SQ4  COMPUTATION OF THE VALUE, THE GRADIENT, AND THE SPARSE
!         NORMAL EQUATION MATRIX OF THE OBJECTIVE FUNCTION WHICH IS
!         DEFINED AS A SUM OF SQUARES OF THE APPROXIMATED FUNCTIONS.
!  S   PA2SQ8  COMPUTATION OF THE VALUE, THE GRADIENT, AND THE SPARSE
!         NORMAL EQUATION MATRIX OF THE OBJECTIVE FUNCTION WHICH IS
!         DEFINED AS A SUM OF SQUARES OF THE APPROXIMATED FUNCTIONS.
!  S   PCBS04  ELIMINATION OF BOX CONSTRAINT VIOLATIONS.
!  S   PDSGM4  DIRECTION DETERMINATION USING THE STEIHAUG-TOINT AND
!         SHIFTED STEIHAUG-TOINT TRUST-REGION METHOD.
!  S   PFSET3  PREPARATION OF THE SPARSE NORMAL EQUATION MATRIX
!         STRUCTURE.
!  S   PS0G01  STEPSIZE SELECTION USING TRUST REGION.
!  S   PUBBM2  PARTITIONED VARIABLE METRIC UPDATES.
!  S   PUSSD5  COMPUTATION OF THE GAUSS-NEWTON MATRIX.
!  S   PUSMM1  SPARSE VARIABLE METRIC (MARWIL) UPDATE.
!  S   PYADC0  ADDITION OF A BOX CONSTRAINT.
!  S   PYFUT1  TEST ON TERMINATION.
!  S   PYRMC0  DELETION OF A BOX CONSTRAINT.
!  S   PYTRCD  COMPUTATION OF PROJECTED DIFFERENCES FOR THE VARIABLE MET
!         UPDATE.
!  S   PYTRCG  COMPUTATION OF THE PROJECTED GRADIENT.
!  S   PYTRCS  COMPUTATION OF THE PROJECTED DIRECTION VECTOR.
!  S   PYTSCH  CORRECTION OF THE HESSIAN MATRIX.
!  S   MXBSMI  INITIATION OF THE PARTITIONED HESSIAN MATRIX.
!  S   MXSSMI  SPARSE SYMMETRIC MATRIX IS REPLACED BY THE UNIT MATRIX.
!  S   MXUDIR  VECTOR AUGMENTED BY THE SCALED VECTOR.
!  S   MXVCOP  COPYING OF A VECTOR.
!  S   MXVDIF  DIFFERENCE OF TWO VECTORS.
!  S   MXVINB  PROJECTION OF A SPARSE SYMMETRIC MATRIX TO SATISFY BOX
!         CONSTRAINTS.
!  S   MXVINE  RESTORATION OF A SPARSE SYMMETRIC MATRIX OBTAINED BY
!         MXVINB
!  S   MXVINS  INITIATION OF THE INTEGER VECTOR.
!  S   MXVSAV  RESTORATION OF THE GRADIENT VECTOR.
!
! EXTERNAL SUBROUTINES :
!  SE  FUN  COMPUTATION 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  DFUN  COMPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION.
!         CALLING SEQUENCE: CALL DFUN(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 :
! HYBRID GAUSS-NEWTON METHOD WITH VARIOUS SECOND ORDER CORRECTIONS AND
! TRUST-REGION STRATEGIES BASED ON CONJUGATE GRADIENT ITERATIONS.
!
      SUBROUTINE PGAC (NF, NA, NB, MMAX, X, IX, XL, XU, AF, GA, AG, G,
     &HA, AH, H, IH, JH, IAG, JAG, S, XO, GO, AGO, XS, GS, IW, XMAX,
     &TOLX, TOLF, TOLB, TOLG, FMIN, XDEL, ETA, GMAX, F, MIT, MFV, MFG,
     &MEC, MOS1, MOS2, IDER, IPRNT, ITERM)
      INTEGER NF,NA,NB,MMAX,IX(*),IH(*),JH(*),IAG(*),JAG(*),IW(*),MIT,
     &MFV,MFG,MEC,MOS1,MOS2,IDER,IPRNT,ITERM
      DOUBLE PRECISION X(*),XL(*),XU(*),AF(*),GA(*),AG(*),G(*),HA(*),
     &AH(*),H(*),S(*),XO(*),GO(*),AGO(*),XS(*),GS(*),XMAX,TOLX,TOLF,
     &TOLG,TOLB,XDEL,FMIN,ETA,GMAX,F
      INTEGER IDECF,ITERD,ITERS,ITERH,KD,LD,NTESX,NTESF,MTESX,MTESF,
     &MRED,KIT,IREST,KBF,MET,MET1,MET3,MES1,MES2,MES3,MOS3,MAXST,IDIR,
     &ISYS,IEST,ITES,KTERS,IRES1,IRES2,NRED,IPOM1,INEW,IOLD,I,M,N,ISNA
      DOUBLE PRECISION R,RO,FO,FP,P,PO,PP,GNORM,GNORMO,SNORM,RMAX,FMAX,
     &DMAX,UMAX,ETA0,ETA2,ETA9,EPS4,EPS5,EPS8,EPS9,BET1,BET2,GAM1,GAM2,
     &DEL1,XDELO
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      IF (ABS(IPRNT).GT.1) WRITE (6,'(1X,''ENTRY TO PGAC :'')')
!
!     INITIATION
!
      KBF=0
      IF (NB.GT.0) KBF=2
      NRES=0
      NDEC=0
      NIN=0
      NIT=0
      NFV=0
      NFG=0
      NFH=0
      IDIR=0
      ISYS=0
      ITES=1
      MTESX=2
      MTESF=2
      ITERM=0
      ITERD=0
      ITERS=2
      ITERH=0
      KTERS=0
      IREST=-1
      IRES1=999
      IRES2=0
      IDECF=0
      MRED=10
      MES1=3
      MES2=2
      MES3=1
      MOS3=0
      ETA0=1.0D-15
      ETA2=1.0D-8
      ETA9=1.0D120
      EPS4=0.10D0
      EPS5=0.90D0
      EPS8=1.00D0
      EPS9=1.00D-8
      BET1=0.05D0
      BET2=0.75D0
      GAM1=2.0D0
      GAM2=1.0D6
      DEL1=0.95D0
      RMAX=ETA9
      DMAX=ETA9
      FMAX=1.0D60
      FMIN=MAX(FMIN,0.0D0)
      IEST=1
      IF (XMAX.LE.0.0D0) XMAX=1.0D16
      XDEL=MIN(XDEL,XMAX)
      IF (TOLX.LE.0.0D0) TOLX=1.0D-16
      IF (TOLF.LE.0.0D0) TOLF=1.0D-14
      IF (TOLG.LE.0.0D0) TOLG=1.0D-6
      IF (TOLB.LE.0.0D0) TOLB=FMIN+1.0D-16
      IF (ETA.LE.0.0D0) ETA=1.5D-4
      IDER=MAX(IDER,0)
      IF (MIT.LE.0) MIT=5000
      IF (MFV.LE.0) MFV=5000
      IF (MFG.LE.0) MFG=10000
      IF (MEC.LE.0) MEC=2
      IF (MOS1.LE.0) MOS1=1
      IF (MOS1.EQ.2) MOS1=5
      IF (MOS2.LE.0) MOS2=2
      IF (MEC.EQ.1) THEN
        MET1=1
      ELSE IF (MEC.EQ.2) THEN
        MET=2
      ELSE
        MET=4
        MET1=1
        MET3=3
      END IF
      ISNA=MEC-1
      KD=2
      LD=-1
      KIT=0
      FO=FMIN
      IPOM1=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
   10   CONTINUE
      END IF
      CALL MXVINP (NF+1, IH)
      CALL MXVINP (NF, JH)
      CALL PFSET3 (NF, NA, M, MMAX, IH, JH, IAG, JAG, ITERM)
      IF (ITERM.NE.0) GO TO 70
      IF (KBF.GT.0) THEN
        CALL PCBS04 (NF, X, IX, XL, XU, EPS9, KBF)
        CALL PYADC0 (NF, N, X, IX, XL, XU, INEW)
        CALL MXVINE (IH(NF+1)-1, JH)
      END IF
      IF (ITERM.NE.0) GO TO 70
      IF (MEC.NE.2) THEN
        CALL PA2SQ4 (NF, NA, X, GA, AG, G, H, IH, JH, IAG, JAG, AF, F,
     &   ETA0, KD, LD, ISNA, NFV, NFG, IDER, IDECF)
      ELSE
        CALL PA2SQ8 (NF, NA, X, IX, GA, G, GO, XS, HA, H, IH, JH, IAG,
     &   JAG, AF, F, ETA0, KBF, KD, LD, NFV, NFG, IPOM1, IDER, IDECF)
      END IF
!
!     START OF THE ITERATION WITH TESTS FOR TERMINATION.
!
   20 CALL PYTRCG (NF, NF, IX, G, UMAX, GMAX, KBF, IOLD)
      IF (ABS(IPRNT).GT.1) WRITE (6,'(1X,''NIT='',I5,2X,''NFV='',I5,2X,'
     &'NFG='',I5,2X,       ''F='', G16.9,2X,''G='',E10.3)') NIT,NFV,NFG,
     &F,GMAX
      CALL PYFUT1 (NF, F, FO, UMAX, GMAX, DMAX, TOLX, TOLF, TOLB, TOLG,
     &KD, NIT, KIT, MIT, NFV, MFV, NFG, MFG, NTESX, MTESX, NTESF, MTESF,
     & ITES, IRES1, IRES2, IREST, ITERS, ITERM)
      IF (ITERM.NE.0) GO TO 70
      IF (KBF.GT.0) CALL PYRMC0 (NF, N, IX, G, EPS8, UMAX, GMAX, RMAX,
     &IOLD, IREST)
   30 IF (MEC.GE.3) THEN
        IF (IREST.LT.0.OR.NIT.LE.1) CALL MXBSMI (NA, AH, IAG)
      END IF
      IF (IREST.GT.0) THEN
        CALL MXSSMI (NF, H, IH)
        IDECF=0
        LD=MIN(LD,1)
        IF (KIT.LT.NIT) THEN
          NRES=NRES+1
          KIT=NIT
        ELSE
          ITERM=-10
          IF (ITERS.LT.0) ITERM=ITERS-5
          IF (GMAX.LE.1.0D2*TOLG) ITERM=-ITERM
        END IF
      ELSE IF (MEC.GE.3) THEN
        IF (IDIR.EQ.0.AND.FO-F.LE.ETA*FO) THEN
          CALL PUSSD5 (NA, AF, AH, IAG, JAG, H, IH, JH)
          IDECF=0
          LD=MIN(LD,1)
        END IF
      END IF
      IF (ITERM.NE.0) GO TO 70
      IF (KBF.GT.0) THEN
        CALL MXVINB (M, IX, JH)
        CALL PYTSCH (NF, IX, H, IH, JH, KBF)
      END IF
!
!     DIRECTION DETERMINATION
!
      CALL PDSGM4 (NF, MMAX, IX, G, H, IH, JH, S, XO, GO, XS, GS, IW,
     &XMAX, XDEL, GNORM, GNORMO, SNORM, FMIN, F, P, PP, ETA0, ETA2,
     &DEL1, KD, KBF, MOS1, MOS2, MOS3, IEST, IDECF, NDEC, NIT, NIN,
     &ITERD, ITERM)
!
!     TEST ON LOCALLY CONSTRAINED STEP AND PREPARATION OF STEPSIZE
!     SELECTION
!
      IF (ITERD.LT.0) THEN
        ITERM=ITERD
      ELSE
        IF (SNORM.LE.0.0D0) THEN
          IREST=MAX(IREST,1)
        ELSE
          IREST=0
        END IF
        IF (IREST.EQ.0) THEN
          RMAX=XMAX/SNORM
        END IF
      END IF
      IF (ITERM.NE.0) GO TO 70
      IF (IREST.NE.0) GO TO 30
      IF (NIT.EQ.1) KIT=NIT
      CALL PYTRCS (NF, X, IX, XO, XL, XU, G, GO, S, RO, FP, FO, F, PO,
     &P, RMAX, ETA9, KBF)
      IF (MEC.GE.3) CALL MXVCOP (IAG(NA+1)-1, AG, AGO)
      IF (RMAX.EQ.0.0D0) GO TO 60
   40 CALL PS0G01 (R, F, FO, PO, PP, XDEL, XDELO, XMAX, RMAX, SNORM,
     &BET1, BET2, GAM1, GAM2, EPS4, EPS5, KD, LD, IDIR, ITERS, ITERD,
     &MAXST, NRED, MRED, KTERS, MES1, MES2, MES3, ISYS)
      IF (ISYS.EQ.0) GO TO 50
      CALL MXUDIR (NF, R, S, XO, X, IX, KBF)
      CALL PCBS04 (NF, X, IX, XL, XU, EPS9, KBF)
      IF (MEC.NE.2) THEN
        CALL PA2SQ4 (NF, NA, X, GA, AG, G, H, IH, JH, IAG, JAG, AF, F,
     &   ETA0, KD, LD, ISNA, NFV, NFG, IDER, IDECF)
      ELSE
        CALL PA2SQ8 (NF, NA, X, IX, GA, G, GO, XS, HA, H, IH, JH, IAG,
     &   JAG, AF, F, ETA0, KBF, KD, LD, NFV, NFG, IPOM1, IDER, IDECF)
      END IF
      GO TO 40
   50 CONTINUE
      KD=2
      IF (ITERS.LE.0) THEN
        R=0.0D0
        F=FO
        P=PO
        CALL MXVCOP (NF, XO, X)
!      IF (MEC.NE.2) THEN
!      ELSE
!      IF (ITERS.LT.0) THEN
!      ITERM=-6
!      IF (GMAX.LE.1.0D 2*TOLG) ITERM=-ITERM
!      GO TO 11180
!      END IF
!      END IF
        IF (IDIR.EQ.0) IREST=MAX(IREST,1)
        LD=KD
        GO TO 30
      END IF
      IF (MEC.EQ.1) THEN
        IF (FO-F.LE.ETA*FO) KD=1
      ELSE IF (MEC.EQ.2) THEN
        IF (MET.GE.2.AND.FO-F.GE.ETA*FO) IPOM1=1
      END IF
      IF (KD.GT.LD) THEN
        IF (MEC.NE.2) THEN
          CALL PA2SQ4 (NF, NA, X, GA, AG, G, H, IH, JH, IAG, JAG, AF, F,
     &      ETA0, KD, LD, ISNA, NFV, NFG, IDER, IDECF)
        ELSE
          CALL PA2SQ8 (NF, NA, X, IX, GA, G, GO, XS, HA, H, IH, JH, IAG,
     &      JAG, AF, F, ETA0, KBF, KD, LD, NFV, NFG, IPOM1, IDER, IDECF)
        END IF
      END IF
      IPOM1=0
      ITERD=0
      CALL PYTRCD (NF, X, IX, XO, G, GO, R, F, FO, P, PO, DMAX, KBF, KD,
     & LD, ITERS)
      IF (MEC.EQ.1) THEN
        IF (FO-F.LE.ETA*FO) THEN
          IDECF=0
          CALL PUSMM1 (NF, H, IH, JH, G, XS, S, XO, GO, IX, R, PO, NIT,
     &     KIT, MET1, ITERD, ITERH, KBF)
        END IF
      ELSE IF (MEC.EQ.3) THEN
        IF (ITERS.GT.0) THEN
          CALL MXVDIF (IAG(NA+1)-1, AG, AGO, AGO)
        ELSE
          CALL MXVSAV (IAG(NA+1)-1, AG, AGO)
        END IF
        CALL PUBBM2 (NA, AH, IAG, JAG, S, XO, AGO, ETA0, ETA9, NIT, KIT,
     &    ITERH, MET, MET1, MET3)
      END IF
   60 CONTINUE
      IF (MEC.NE.2) THEN
        IF (IDIR.EQ.0) THEN
          IF (ITERH.NE.0) THEN
            IREST=MAX(IREST,1)
          END IF
          IF (KBF.GT.0) CALL PYADC0 (NF, N, X, IX, XL, XU, INEW)
          GO TO 20
        ELSE
          GO TO 30
        END IF
      ELSE
        IF (KBF.GT.0) CALL PYADC0 (NF, N, X, IX, XL, XU, INEW)
        GO TO 20
      END IF
   70 CONTINUE
      IF (IPRNT.GT.1.OR.IPRNT.LT.0) WRITE (6,'(1X,''EXIT FROM PGAC :'')'
     &)
      IF (IPRNT.NE.0) WRITE (6,'(1X,''NIT='',I5,2X,''NFV='',I5,2X,''NFG=
     &'',I5,2X,       ''F='', G16.9,2X,''G='',E10.3,2X,''ITERM='',I3)')
     &NIT,NFV,NFG,F,GMAX,ITERM
      IF (IPRNT.LT.0) WRITE (6,'(1X,''X='',5(G14.7,1X):/(3X,5(G14.7,1X))
     &)') (X(I),I=1,NF)
      RETURN
      END
! SUBROUTINE PGADU              ALL SYSTEMS                   97/01/22
! PURPOSE :
! EASY TO USE SUBROUTINE FOR LARGE-SCALE UNCONSTRAINED LEAST-SQUARES
! PROBLEMS WITH SPARSE JACOBIAN MATRICES.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  II  NA  NUMBER OF APPROXIMATED FUNCTIONS.
!  IU  MA  NUMBER OF NONZERO ELEMENTS IN THE JACOBIAN MATRIX.
!  RI  X(NF)  VECTOR OF VARIABLES.
!  RO  AF(NA)  VECTOR CONTAINING VALUES OF THE APPROXIMATED
!         FUNCTIONS.
!  RI  IAG(NA+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE JACOBIAN
!         MATRIX.
!  RI  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE JACOBIAN MATRIX.
!  II  IPAR(7)  INTEGER PAREMETERS:
!      IPAR(1)  MAXIMUM NUMBER OF ITERATIONS.
!      IPAR(2)  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!      IPAR(3)  MAXIMUM NUMBER OF GRADIENT EVALUATIONS.
!      IPAR(4)  TYPE OF THE SECOND ORDER CORRECTION. MET=1-THE MARWIL
!         SPARSE VARIABLE METRIC UPDATE. MET=2-THE NEWTON CORRECTION
!         BY USING GRADIENT DIFFERENCES. MET=3-THE PARTITIONED VARIABLE
!         METRIC UPDATE.
!      IPAR(5)  METHOD FOR COMPUTING THE TRUST REGION STEP. MOS=1-THE
!         DOG-LEG METHOD. MOS=2-THE MORE-SORENSEN METHOD.
!      IPAR(6)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PNED.
!      IPAR(7)  NUMBER DEFINING THE SPACE FOR FILL-IN (THE SIZE OF THIS
!         SPACE IS IFIL TIMES THE STANDARD SIZE). THE DEFAULT VALUE IS
!         IFIL=1. THE DEFAULT VALUE HAS TO BE INCREASED IF ITERM IS
!         LESS OR EQUAL TO -40.
!  RI  RPAR(9)  REAL PARAMETERS:
!      RPAR(1)  MAXIMUM STEPSIZE.
!      RPAR(2)  TOLERANCE FOR THE CHANGE OF VARIABLES.
!      RPAR(3)  TOLERANCE FOR THE CHANGE OF FUNCTION VALUES.
!      RPAR(4)  TOLERANCE FOR THE FUNCTION FALUE.
!      RPAR(5)  TOLERANCE FOR THE GRADIENT NORM.
!      RPAR(6)  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!      RPAR(7)  INITIAL TRUST-REGION RADIUS.
!      RPAR(8)  TOLERANCE FOR THE SWITCH BETWEEN THE GAUSS-NEWTON AND
!      RPAR(9)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PNED.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  II  IDER  DEGREE OF ANALYTICALLY COMPUTED DERIVATIVES (0 OR 1).
!  II  ISPAS  INPUT SPARSE STRUCTURE. ISPAS=1-STANDARD COORDINATE
!         FORM. ISPAS=2-SPARSE STRUCTURE COMPRESSED BY ROWS.
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!         VALUES ITERM<=-40 DETECT A LACK OF SPACE. IN THIS CASE,
!         PARAMETER IPAR(7) HAS TO BE INCREASED.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PGAD  HYBRID METHOD FOR SPARSE LEAST SQUARES PROBLEMS.
!  S   PASED3  COMPRESSED SPARSE STRUCTURE OF THE JACOBIAN MATRIX IS
!         COMPUTED FROM THE COORDINATE FORM.
!  S   PFSET2  NUMBER OF NONZERO ELEMENTS IN THE PARTITIONED HESSIAN
!         MATRIX.
!
! EXTERNAL SUBROUTINES :
!  SE  FUN  COMPUTATION 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  DFUN  COMPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION.
!         CALLING SEQUENCE: CALL DFUN(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 PGADU (NF, NA, MA, X, AF, IAG, JAG, IPAR, RPAR, F,
     &GMAX, IDER, ISPAS, IPRNT, ITERM)
      INTEGER NF,NA,MA,IAG(*),JAG(*),IPAR(7),IDER,ISPAS,IPRNT,ITERM
      DOUBLE PRECISION X(*),AF(*),RPAR(9),F,GMAX
      INTEGER NB,LGA,LAG,LG,LHA,LAH,LH,LS,LXO,LGO,LAGO,LXS,LIH,LJH,LPSL,
     &LPERM,LINVP,LWN11,LWN12,LWN13,LWN14,MH,ML,IFIL,IER
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      INTEGER IA(:)
      DOUBLE PRECISION RA(:)
      ALLOCATABLE IA,RA
      IFIL=IPAR(7)
      IF (IFIL.LE.0) IFIL=1
      IF (ISPAS.LE.1) THEN
        CALL PASED3 (NF, NA, MA, IAG, JAG, IER)
        IF (IER.NE.0) THEN
          WRITE (6,'(''INPUT ERROR : IER = '',I3)') IER
          STOP
        END IF
      ELSE
        MA=IAG(NA+1)-1
      END IF
      CALL PFSET2 (NA, MH, ML, IAG)
      ALLOCATE(IA(8*NF+6+(IFIL+3)*MH))
      IF (IPAR(4).LE.2) THEN
        ALLOCATE(RA(6*NF+ML+(IFIL+3)*MH))
      ELSE
        ALLOCATE(RA(6*NF+2*MA+ML+(IFIL+4)*MH))
      END IF
      NB=0
!
!     POINTERS FOR AUXILIARY ARRAYS
!
      LGA=1
      LG=LGA+NF
      LS=LG+NF
      LXO=LS+NF
      LGO=LXO+NF
      LXS=LGO+NF
      IF (IPAR(4).LE.2) THEN
        LAG=LXS
        LAGO=LXS
        LAH=LXS
        LHA=LXS+NF
      ELSE
        LAG=LXS+NF
        LAGO=LAG+MA
        LAH=LAGO+MA
        LHA=LAH+MH
      END IF
      LH=LHA+ML
      LIH=1
      LPSL=LIH+NF+1
      LPERM=LPSL+NF+1
      LINVP=LPERM+NF
      LWN11=LINVP+NF
      LWN12=LWN11+NF+1
      LWN13=LWN12+NF+1
      LWN14=LWN13+NF+1
      LJH=LWN14+NF+1
      CALL PGAD (NF, NA, NB, (IFIL+3)*MH, X, IA, RA, RA, AF, RA(LGA),
     &RA(LAG), RA(LG), RA(LHA), RA(LAH), RA(LH), IA(LIH), IA(LJH), IAG,
     &JAG, RA(LS), RA(LXO), RA(LGO), RA(LAGO), RA(LXS), IA(LPSL),
     &IA(LPERM), IA(LINVP), IA(LWN11), IA(LWN12), IA(LWN13), IA(LWN14),
     &RPAR(1), RPAR(2), RPAR(3), RPAR(4), RPAR(5), RPAR(6), RPAR(7),
     &RPAR(8), GMAX, F, IPAR(1), IPAR(2), IPAR(3), IPAR(4), IPAR(5),
     &IDER, IPRNT, ITERM)
      DEALLOCATE(IA,RA)
      RETURN
      END
! SUBROUTINE PGADS              ALL SYSTEMS                   97/01/22
! PURPOSE :
! EASY TO USE SUBROUTINE FOR LARGE-SCALE BOX CONSTRAINED LEAST-SQUARES
! PROBLEMS WITH SPARSE JACOBIAN MATRICES.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  II  NA  NUMBER OF APPROXIMATED FUNCTIONS.
!  IU  MA  NUMBER OF NONZERO ELEMENTS IN THE JACOBIAN MATRIX.
!  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-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  AF(NA)  VECTOR CONTAINING VALUES OF THE APPROXIMATED
!         FUNCTIONS.
!  RI  IAG(NA+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE JACOBIAN
!         MATRIX.
!  RI  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE JACOBIAN MATRIX.
!  II  IPAR(7)  INTEGER PAREMETERS:
!      IPAR(1)  MAXIMUM NUMBER OF ITERATIONS.
!      IPAR(2)  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!      IPAR(3)  MAXIMUM NUMBER OF GRADIENT EVALUATIONS.
!      IPAR(4)  TYPE OF THE SECOND ORDER CORRECTION. MET=1-THE MARWIL
!         SPARSE VARIABLE METRIC UPDATE. MET=2-THE NEWTON CORRECTION
!         BY USING GRADIENT DIFFERENCES. MET=3-THE PARTITIONED VARIABLE
!         METRIC UPDATE.
!      IPAR(5)  METHOD FOR COMPUTING THE TRUST REGION STEP. MOS=1-THE
!         DOG-LEG METHOD. MOS=2-THE MORE-SORENSEN METHOD.
!      IPAR(6)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PNED.
!      IPAR(7)  NUMBER DEFINING THE SPACE FOR FILL-IN (THE SIZE OF THIS
!         SPACE IS IFIL TIMES THE STANDARD SIZE). THE DEFAULT VALUE IS
!         IFIL=1. THE DEFAULT VALUE HAS TO BE INCREASED IF ITERM IS
!         LESS OR EQUAL TO -40.
!  RI  RPAR(9)  REAL PARAMETERS:
!      RPAR(1)  MAXIMUM STEPSIZE.
!      RPAR(2)  TOLERANCE FOR THE CHANGE OF VARIABLES.
!      RPAR(3)  TOLERANCE FOR THE CHANGE OF FUNCTION VALUES.
!      RPAR(4)  TOLERANCE FOR THE FUNCTION FALUE.
!      RPAR(5)  TOLERANCE FOR THE GRADIENT NORM.
!      RPAR(6)  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!      RPAR(7)  INITIAL TRUST-REGION RADIUS.
!      RPAR(8)  TOLERANCE FOR THE SWITCH BETWEEN THE GAUSS-NEWTON AND
!      RPAR(9)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PNED.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  II  IDER  DEGREE OF ANALYTICALLY COMPUTED DERIVATIVES (0 OR 1).
!  II  ISPAS  INPUT SPARSE STRUCTURE. ISPAS=1-STANDARD COORDINATE
!         FORM. ISPAS=2-SPARSE STRUCTURE COMPRESSED BY ROWS.
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!         VALUES ITERM<=-40 DETECT A LACK OF SPACE. IN THIS CASE,
!         PARAMETER IPAR(7) HAS TO BE INCREASED.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PGAD  HYBRID METHOD FOR SPARSE LEAST SQUARES PROBLEMS.
!  S   PASED3  COMPRESSED SPARSE STRUCTURE OF THE JACOBIAN MATRIX IS
!         COMPUTED FROM THE COORDINATE FORM.
!  S   PFSET2  NUMBER OF NONZERO ELEMENTS IN THE PARTITIONED HESSIAN
!         MATRIX.
!
! EXTERNAL SUBROUTINES :
!  SE  FUN  COMPUTATION 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  DFUN  COMPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION.
!         CALLING SEQUENCE: CALL DFUN(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 PGADS (NF, NA, MA, X, IX, XL, XU, AF, IAG, JAG, IPAR,
     &RPAR, F, GMAX, IDER, ISPAS, IPRNT, ITERM)
      INTEGER NF,NA,MA,IX(*),IAG(*),JAG(*),IPAR(7),IDER,ISPAS,IPRNT,
     &ITERM
      DOUBLE PRECISION X(*),XL(*),XU(*),AF(*),RPAR(9),F,GMAX
      INTEGER NB,LGA,LAG,LG,LHA,LAH,LH,LS,LXO,LGO,LAGO,LXS,LIH,LJH,LPSL,
     &LPERM,LINVP,LWN11,LWN12,LWN13,LWN14,MH,ML,IFIL,IER
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      INTEGER IA(:)
      DOUBLE PRECISION RA(:)
      ALLOCATABLE IA,RA
      IFIL=IPAR(7)
      IF (IFIL.LE.0) IFIL=1
      IF (ISPAS.LE.1) THEN
        CALL PASED3 (NF, NA, MA, IAG, JAG, IER)
        IF (IER.NE.0) THEN
          WRITE (6,'(''INPUT ERROR : IER = '',I3)') IER
          STOP
        END IF
      ELSE
        MA=IAG(NA+1)-1
      END IF
      CALL PFSET2 (NA, MH, ML, IAG)
      ALLOCATE(IA(8*NF+6+(IFIL+3)*MH))
      IF (IPAR(4).LE.2) THEN
        ALLOCATE(RA(6*NF+ML+(IFIL+3)*MH))
      ELSE
        ALLOCATE(RA(6*NF+2*MA+ML+(IFIL+4)*MH))
      END IF
      NB=1
!
!     POINTERS FOR AUXILIARY ARRAYS
!
      LGA=1
      LG=LGA+NF
      LS=LG+NF
      LXO=LS+NF
      LGO=LXO+NF
      LXS=LGO+NF
      IF (IPAR(4).LE.2) THEN
        LAG=LXS
        LAGO=LXS
        LAH=LXS
        LHA=LXS+NF
      ELSE
        LAG=LXS+NF
        LAGO=LAG+MA
        LAH=LAGO+MA
        LHA=LAH+MH
      END IF
      LH=LHA+ML
      LIH=1
      LPSL=LIH+NF+1
      LPERM=LPSL+NF+1
      LINVP=LPERM+NF
      LWN11=LINVP+NF
      LWN12=LWN11+NF+1
      LWN13=LWN12+NF+1
      LWN14=LWN13+NF+1
      LJH=LWN14+NF+1
      CALL PGAD (NF, NA, NB, (IFIL+3)*MH, X, IX, XL, XU, AF, RA(LGA),
     &RA(LAG), RA(LG), RA(LHA), RA(LAH), RA(LH), IA(LIH), IA(LJH), IAG,
     &JAG, RA(LS), RA(LXO), RA(LGO), RA(LAGO), RA(LXS), IA(LPSL),
     &IA(LPERM), IA(LINVP), IA(LWN11), IA(LWN12), IA(LWN13), IA(LWN14),
     &RPAR(1), RPAR(2), RPAR(3), RPAR(4), RPAR(5), RPAR(6), RPAR(7),
     &RPAR(8), GMAX, F, IPAR(1), IPAR(2), IPAR(3), IPAR(4), IPAR(5),
     &IDER, IPRNT, ITERM)
      DEALLOCATE(IA,RA)
      RETURN
      END
! SUBROUTINE PGAD               ALL SYSTEMS                   01/09/22
! PURPOSE :
! GENERAL SUBROUTINE FOR LARGE-SCALE BOX CONSTRAINED LEAST-SQUARES
! PROBLEMS WITH SPARSE JACOBIAN MATRICES.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  II  NA  NUMBER OF APPROXIMATING FUNCTIONS.
!  II  MA  NUMBER OF NONZERO ELEMENTS IN THE JACOBIAN MATRIX.
!  II  MMAX  MAXIMUM DIMENSION OF THE SPARSE TABLEAU.
!  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-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  AF(NA)  VECTOR CONTAINING VALUES OF THE APPROXIMATED
!         FUNCTIONS.
!  RA  GA(NF)  GRADIENT OF THE SELECTED APPROXIMATING FUNCTION.
!  RA  AG(MA)  JACOBIAN MATRIX OF APPROXIMATING FUNCTIONS.
!  RU  G(NF)  GRADIENT OF THE OBJECTIVE FUNCTION.
!  RA  HA(ML)  HESSIAN MATRIX OF THE SELECTED APPROXIMATING FUNCTION.
!  RA  AH(MH)  ELEMENTS OF THE PARTITIONED HESSIAN MATRIX.
!  RA  H(MMAX)  NONZERO ELEMENTS OF THE SPARSE HESSIAN MATRIX WITH
!         AN ADDITIONAL SPACE USED FOR THE NUMERICAL DIFFERENTIATION.
!  II  IH(NF+1)  POINTERS OF DIAGONAL ELEMENTS OF THE MATRIX H.
!  IU  JH(MMAX)  INDICES OF NONZERO ELEMENTS OF THE MATRIX H
!         TOGETHER WITH AN ADDITIONAL SPACE USED FOR THE NUMERICAL
!         DIFFERENTIATION.
!  RI  IAG(NA+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
!  RI  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
!  RU  S(NF)  DIRECTION VECTOR.
!  RU  XO(NF)  VECTORS OF VARIABLES DIFFERENCE.
!  RU  GO(NF)  GRADIENTS DIFFERENCE.
!  RA  AGO(MA)  OLD JACOBIAN MATRIX OF THE PARTITIONED FUNCTION,
!  RA  XS(NF)  AUXILIARY VECTOR.
!  IA  PSL(NF+1)  POINTER VECTOR OF THE COMPACT FORM OF THE TRIANGULAR
!         FACTOR OF THE HESSIAN APPROXIMATION.
!  IA  PERM(NF)  PERMUTATION VECTOR.
!  IA  INVP(NF)  INVERSE PERMUTATION VECTOR.
!  IA  WN11(NF+1) AUXILIARY VECTOR.
!  IA  WN12(NF+1) AUXILIARY VECTOR.
!  IA  WN13(NF+1) AUXILIARY VECTOR.
!  IA  WN14(NF+1) AUXILIARY VECTOR.
!  RI  XMAX  MAXIMUM STEPSIZE.
!  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 NORM.
!  RI  FMIN  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!  RI  XDEL  TRUST REGION STEPSIZE.
!  RI  ETA   TOLERANCE FOR THE SWITCH BETWEEN THE GAUSS-NEWTON AND
!         THE MARWIL METHODS.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  II  MIT  MAXIMUM NUMBER OF ITERATIONS.
!  II  MFV  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!  II  MFG  MAXIMUM NUMBER OF GRADIENT EVALUATIONS.
!  II  MEC  TYPE OF THE SECOND ORDER CORRECTION. MEC=1-THE MARWIL
!         SPARSE VARIABLE METRIC UPDATE. MEC=2-THE NEWTON CORRECTION
!         BY USING GRADIENT DIFFERENCES. MEC=3-THE PARTITIONED
!         VARIABLE METRIC UPDATE.
!  II  MOS  METHOD FOR COMPUTING THE TRUST REGION STEP. MOS=1-THE
!         DOG-LEG METHOD. MOS=2-THE MORE-SORENSEN METHOD.
!  II  IDER  DEGREE OF ANALYTICALLY COMPUTED DERIVATIVES (0 OR 1).
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!         VALUES ITERM<=-40 DETECT A LACK OF SPACE.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PA2SQ4  COMPUTATION OF THE VALUE, THE GRADIENT, AND THE SPARSE
!         NORMAL EQUATION MATRIX OF THE OBJECTIVE FUNCTION WHICH IS
!         DEFINED AS A SUM OF SQUARES OF THE APPROXIMATED FUNCTIONS.
!  S   PA2SQ8  COMPUTATION OF THE VALUE, THE GRADIENT, AND THE SPARSE
!         NORMAL EQUATION MATRIX OF THE OBJECTIVE FUNCTION WHICH IS
!         DEFINED AS A SUM OF SQUARES OF THE APPROXIMATED FUNCTIONS.
!  S   PCBS04  ELIMINATION OF BOX CONSTRAINT VIOLATIONS.
!  S   PDSGM1  DIRECTION DETERMINATION USING THE DOUBLE DOG-LEG
!         TRUST-REGION METHOD.
!  S   PDSGM7  DIRECTION DETERMINATION USING THE MORE-SORENSEN
!         TRUST-REGION METHOD.
!  S   PFSET3  PREPARATION OF THE SPARSE NORMAL EQUATION MATRIX
!         STRUCTURE.
!  S   PS0G01  STEPSIZE SELECTION USING TRUST REGION.
!  S   PUBBM2  PARTITIONED VARIABLE METRIC UPDATES.
!  S   PUSSD5  COMPUTATION OF THE GAUSS-NEWTON MATRIX.
!  S   PUSMM1  SPARSE VARIABLE METRIC (MARWIL) UPDATE.
!  S   PYADC0  ADDITION OF A BOX CONSTRAINT.
!  S   PYFUT1  TEST ON TERMINATION.
!  S   PYRMC0  DELETION OF A BOX CONSTRAINT.
!  S   PYTRCD  COMPUTATION OF PROJECTED DIFFERENCES FOR THE VARIABLE MET
!         UPDATE.
!  S   PYTRCG  COMPUTATION OF THE PROJECTED GRADIENT.
!  S   PYTRCS  COMPUTATION OF THE PROJECTED DIRECTION VECTOR.
!  S   PYTSCH  CORRECTION OF THE HESSIAN MATRIX.
!  S   MXBSMI  INITIATION OF THE PARTITIONED HESSIAN MATRIX.
!  S   MXSPCC  SPARSE MATRIX REORDERING, SYMBOLIC FACTORIZATION, DATA
!         STRUCTURES TRANSFORMATION. INITIATION OF THE DIRECT SPARSE
!         SOLVER.
!  S   MXSSMI  SPARSE SYMMETRIC MATRIX IS REPLACED BY THE UNIT MATRIX.
!  S   MXUDIR  VECTOR AUGMENTED BY THE SCALED VECTOR.
!  S   MXVCOP  COPYING OF A VECTOR.
!  S   MXVDIF  DIFFERENCE OF TWO VECTORS.
!  S   MXVINB  PROJECTION OF A SPARSE SYMMETRIC MATRIX TO SATISFY BOX
!         CONSTRAINTS.
!  S   MXVINE  RESTORATION OF A SPARSE SYMMETRIC MATRIX OBTAINED BY
!         MXVINB
!  S   MXVINS  INITIATION OF THE INTEGER VECTOR.
!  S   MXVSAV  RESTORATION OF THE GRADIENT VECTOR.
!
! EXTERNAL SUBROUTINES :
!  SE  FUN  COMPUTATION 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  DFUN  COMPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION.
!         CALLING SEQUENCE: CALL DFUN(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 :
! HYBRID GAUSS-NEWTON METHOD WITH VARIOUS SECOND ORDER CORRECTIONS AND
! TRUST-REGION STRATEGIES BASED ON DIRECT MATRIX DECOMPOSITIONS.
!
      SUBROUTINE PGAD (NF, NA, NB, MMAX, X, IX, XL, XU, AF, GA, AG, G,
     &HA, AH, H, IH, JH, IAG, JAG, S, XO, GO, AGO, XS, PSL, PERM, INVP,
     &WN11, WN12, WN13, WN14, XMAX, TOLX, TOLF, TOLB, TOLG, FMIN, XDEL,
     &ETA, GMAX, F, MIT, MFV, MFG, MEC, MOS, IDER, IPRNT, ITERM)
      INTEGER NF,NA,NB,MMAX,IX(*),IH(*),JH(*),IAG(*),JAG(*),PSL(*),
     &PERM(*),INVP(*),WN11(*),WN12(*),WN13(*),WN14(*),IPRNT,MIT,MFV,MFG,
     &MEC,MOS,IDER,ITERM
      DOUBLE PRECISION X(*),XL(*),XU(*),AF(*),GA(*),AG(*),G(*),HA(*),
     &AH(*),H(*),S(*),XO(*),GO(*),AGO(*),XS(*),XMAX,TOLX,TOLF,TOLG,TOLB,
     &XDEL,FMIN,ETA,GMAX,F
      INTEGER IDECF,ITERD,ITERS,ITERH,KD,LD,NTESX,NTESF,MTESX,MTESF,
     &MRED,KIT,IREST,KBF,MET,MET1,MET3,MES1,MES2,MES3,MAXST,IDIR,ISYS,
     &IEST,ITES,KTERS,IRES1,IRES2,NRED,IPOM1,INEW,IOLD,I,M,MH,N,ISNA
      DOUBLE PRECISION R,RO,FO,FP,P,PO,PP,GNORM,SNORM,RMAX,FMAX,DMAX,
     &UMAX,ETA0,ETA2,ETA9,EPS4,EPS5,EPS8,EPS9,ALF2,BET1,BET2,GAM1,GAM2,
     &DEL1,DEL2,XDELO
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      IF (ABS(IPRNT).GT.1) WRITE (6,'(1X,''ENTRY TO PGAD :'')')
!
!     INITIATION
!
      KBF=0
      IF (NB.GT.0) KBF=2
      NRES=0
      NDEC=0
      NIN=0
      NIT=0
      NFV=0
      NFG=0
      NFH=0
      IDIR=0
      ISYS=0
      ITES=1
      MTESX=2
      MTESF=2
      ITERM=0
      ITERD=0
      ITERS=2
      ITERH=0
      KTERS=0
      IREST=-1
      IRES1=999
      IRES2=0
      IDECF=0
      MRED=10
      MES1=3
      MES2=2
      MES3=1
      ETA0=1.0D-15
      ETA2=1.0D-18
      ETA9=1.0D120
      EPS4=0.10D0
      EPS5=0.90D0
      EPS8=1.00D0
      EPS9=1.00D-8
      ALF2=1.0D6
      BET1=0.05D0
      BET2=0.75D0
      GAM1=2.0D0
      GAM2=1.0D6
      DEL1=0.9D0
      DEL2=1.1D0
      RMAX=ETA9
      DMAX=ETA9
      FMAX=1.0D60
      FMIN=MAX(FMIN,0.0D0)
      IEST=1
      IF (XMAX.LE.0.0D0) XMAX=1.0D16
      XDEL=MIN(XDEL,XMAX)
      IF (TOLX.LE.0.0D0) TOLX=1.0D-16
      IF (TOLF.LE.0.0D0) TOLF=1.0D-14
      IF (TOLG.LE.0.0D0) TOLG=1.0D-6
      IF (TOLB.LE.0.0D0) TOLB=FMIN+1.0D-16
      IF (ETA.LE.0.0D0) ETA=1.5D-4
      IDER=MAX(IDER,0)
      IF (MIT.LE.0) MIT=5000
      IF (MFV.LE.0) MFV=5000
      IF (MFG.LE.0) MFG=10000
      IF (MEC.LE.0) MEC=2
      IF (MOS.LE.0) MOS=2
      IF (MEC.EQ.1) THEN
        MET1=1
      ELSE IF (MEC.EQ.2) THEN
        MET=2
      ELSE
        MET=4
        MET1=1
        MET3=3
      END IF
      ISNA=MEC-1
      KD=2
      LD=-1
      KIT=0
      FO=FMIN
      IPOM1=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
   10   CONTINUE
      END IF
      CALL MXVINP (NF+1, IH)
      CALL MXVINP (NF, JH)
      CALL PFSET3 (NF, NA, M, MMAX, IH, JH, IAG, JAG, ITERM)
      IF (ITERM.NE.0) GO TO 70
      IF (KBF.GT.0) THEN
        CALL PCBS04 (NF, X, IX, XL, XU, EPS9, KBF)
        CALL PYADC0 (NF, N, X, IX, XL, XU, INEW)
        CALL MXVINE (IH(NF+1)-1, JH)
      END IF
      MH=0
      CALL MXSPCC (NF, M, MH, MMAX, H, IH, JH, PSL, PERM, INVP, WN11,
     &WN12, WN13, WN14, ITERM)
      IF (ITERM.NE.0) GO TO 70
      IF (MEC.NE.2) THEN
        CALL PA2SQ4 (NF, NA, X, GA, AG, G, H, IH, JH, IAG, JAG, AF, F,
     &   ETA0, KD, LD, ISNA, NFV, NFG, IDER, IDECF)
      ELSE
        CALL PA2SQ8 (NF, NA, X, IX, GA, G, GO, XS, HA, H, IH, JH, IAG,
     &   JAG, AF, F, ETA0, KBF, KD, LD, NFV, NFG, IPOM1, IDER, IDECF)
      END IF
!
!     START OF THE ITERATION WITH TESTS FOR TERMINATION.
!
   20 CALL PYTRCG (NF, NF, IX, G, UMAX, GMAX, KBF, IOLD)
      IF (ABS(IPRNT).GT.1) WRITE (6,'(1X,''NIT='',I5,2X,''NFV='',I5,2X,'
     &'NFG='',I5,2X,       ''F='', G16.9,2X,''G='',E10.3)') NIT,NFV,NFG,
     &F,GMAX
      CALL PYFUT1 (NF, F, FO, UMAX, GMAX, DMAX, TOLX, TOLF, TOLB, TOLG,
     &KD, NIT, KIT, MIT, NFV, MFV, NFG, MFG, NTESX, MTESX, NTESF, MTESF,
     & ITES, IRES1, IRES2, IREST, ITERS, ITERM)
      IF (ITERM.NE.0) GO TO 70
      IF (KBF.GT.0) CALL PYRMC0 (NF, N, IX, G, EPS8, UMAX, GMAX, RMAX,
     &IOLD, IREST)
   30 IF (MEC.GE.3) THEN
        IF (IREST.LT.0.OR.NIT.LE.1) CALL MXBSMI (NA, AH, IAG)
      END IF
      IF (IREST.GT.0) THEN
        CALL MXSSMI (NF, H, IH)
        IDECF=0
        LD=MIN(LD,1)
        IF (KIT.LT.NIT) THEN
          NRES=NRES+1
          KIT=NIT
        ELSE
          ITERM=-10
          IF (ITERS.LT.0) ITERM=ITERS-5
          IF (GMAX.LE.1.0D2*TOLG) ITERM=-ITERM
        END IF
      ELSE IF (MEC.GE.3) THEN
        IF (IDIR.EQ.0.AND.FO-F.LE.ETA*FO) THEN
          CALL PUSSD5 (NA, AF, AH, IAG, JAG, H, IH, JH)
          IDECF=0
          LD=MIN(LD,1)
        END IF
      END IF
      IF (ITERM.NE.0) GO TO 70
      IF (KBF.GT.0) THEN
        CALL MXVINB (M, IX, JH)
        CALL PYTSCH (NF, IX, H, IH, JH, KBF)
      END IF
!
!     DIRECTION DETERMINATION
!
      IF (MOS.LE.1) THEN
        CALL PDSGM1 (NF, MMAX, MH, IX, G, H, IH, JH, S, XO, GO, XS, PSL,
     &    PERM, WN11, WN12, XMAX, XDEL, GNORM, SNORM, FMIN, F, P, PP,
     &   ETA2, ALF2, KD, KBF, IEST, IDECF, NDEC, ITERD, ITERM)
      ELSE
        CALL PDSGM7 (NF, MMAX, MH, IX, G, H, IH, JH, S, XO, GO, PSL,
     &   PERM, WN11, WN12, XMAX, XDEL, XDELO, GNORM, SNORM, FMIN, F, P,
     &   PP, ETA2, DEL1, DEL2, KD, KBF, IEST, IDIR, IDECF, NDEC, ITERD,
     &    ITERM)
      END IF
!
!     TEST ON LOCALLY CONSTRAINED STEP AND PREPARATION OF STEPSIZE
!     SELECTION
!
      IF (ITERD.LT.0) THEN
        ITERM=ITERD
      ELSE
        IF (SNORM.LE.0.0D0) THEN
          IREST=MAX(IREST,1)
        ELSE
          IREST=0
        END IF
        IF (IREST.EQ.0) THEN
          RMAX=XMAX/SNORM
        END IF
      END IF
      IF (ITERM.NE.0) GO TO 70
      IF (IREST.NE.0) GO TO 30
      IF (NIT.EQ.1) KIT=NIT
      CALL PYTRCS (NF, X, IX, XO, XL, XU, G, GO, S, RO, FP, FO, F, PO,
     &P, RMAX, ETA9, KBF)
      IF (MEC.GE.3) CALL MXVCOP (IAG(NA+1)-1, AG, AGO)
      IF (RMAX.EQ.0.0D0) GO TO 60
   40 CALL PS0G01 (R, F, FO, PO, PP, XDEL, XDELO, XMAX, RMAX, SNORM,
     &BET1, BET2, GAM1, GAM2, EPS4, EPS5, KD, LD, IDIR, ITERS, ITERD,
     &MAXST, NRED, MRED, KTERS, MES1, MES2, MES3, ISYS)
      IF (ISYS.EQ.0) GO TO 50
      CALL MXUDIR (NF, R, S, XO, X, IX, KBF)
      CALL PCBS04 (NF, X, IX, XL, XU, EPS9, KBF)
      IF (MEC.NE.2) THEN
        CALL PA2SQ4 (NF, NA, X, GA, AG, G, H, IH, JH, IAG, JAG, AF, F,
     &   ETA0, KD, LD, ISNA, NFV, NFG, IDER, IDECF)
      ELSE
        CALL PA2SQ8 (NF, NA, X, IX, GA, G, GO, XS, HA, H, IH, JH, IAG,
     &   JAG, AF, F, ETA0, KBF, KD, LD, NFV, NFG, IPOM1, IDER, IDECF)
      END IF
      GO TO 40
   50 CONTINUE
      KD=2
      IF (ITERS.LE.0) THEN
        R=0.0D0
        F=FO
        P=PO
        CALL MXVCOP (NF, XO, X)
!      IF (MEC.NE.2) THEN
!      ELSE
!      IF (ITERS.LT.0) THEN
!      ITERM=-6
!      IF (GMAX.LE.1.0D 2*TOLG) ITERM=-ITERM
!      GO TO 11180
!      END IF
!      END IF
        IF (IDIR.EQ.0) IREST=MAX(IREST,1)
        LD=KD
        GO TO 30
      END IF
      IF (MEC.EQ.1) THEN
        IF (FO-F.LE.ETA*FO) KD=1
      ELSE IF (MEC.EQ.2) THEN
        IF (MET.GE.2.AND.FO-F.GE.ETA*FO) IPOM1=1
      END IF
      IF (KD.GT.LD) THEN
        IF (MEC.NE.2) THEN
          CALL PA2SQ4 (NF, NA, X, GA, AG, G, H, IH, JH, IAG, JAG, AF, F,
     &      ETA0, KD, LD, ISNA, NFV, NFG, IDER, IDECF)
        ELSE
          CALL PA2SQ8 (NF, NA, X, IX, GA, G, GO, XS, HA, H, IH, JH, IAG,
     &      JAG, AF, F, ETA0, KBF, KD, LD, NFV, NFG, IPOM1, IDER, IDECF)
        END IF
      END IF
      IPOM1=0
      ITERD=0
      CALL PYTRCD (NF, X, IX, XO, G, GO, R, F, FO, P, PO, DMAX, KBF, KD,
     & LD, ITERS)
      IF (MEC.EQ.1) THEN
        IF (FO-F.LE.ETA*FO) THEN
          IDECF=0
          CALL PUSMM1 (NF, H, IH, JH, G, XS, S, XO, GO, IX, R, PO, NIT,
     &     KIT, MET1, ITERD, ITERH, KBF)
        END IF
      ELSE IF (MEC.EQ.3) THEN
        IF (ITERS.GT.0) THEN
          CALL MXVDIF (IAG(NA+1)-1, AG, AGO, AGO)
        ELSE
          CALL MXVSAV (IAG(NA+1)-1, AG, AGO)
        END IF
        CALL PUBBM2 (NA, AH, IAG, JAG, S, XO, AGO, ETA0, ETA9, NIT, KIT,
     &    ITERH, MET, MET1, MET3)
      END IF
   60 CONTINUE
      IF (MEC.NE.2) THEN
        IF (IDIR.EQ.0) THEN
          IF (ITERH.NE.0) THEN
            IREST=MAX(IREST,1)
          END IF
          IF (KBF.GT.0) CALL PYADC0 (NF, N, X, IX, XL, XU, INEW)
          GO TO 20
        ELSE
          GO TO 30
        END IF
      ELSE
        IF (KBF.GT.0) CALL PYADC0 (NF, N, X, IX, XL, XU, INEW)
        GO TO 20
      END IF
   70 CONTINUE
      IF (IPRNT.GT.1.OR.IPRNT.LT.0) WRITE (6,'(1X,''EXIT FROM PGAD :'')'
     &)
      IF (IPRNT.NE.0) WRITE (6,'(1X,''NIT='',I5,2X,''NFV='',I5,2X,''NFG=
     &'',I5,2X,       ''F='', G16.9,2X,''G='',E10.3,2X,''ITERM='',I3)')
     &NIT,NFV,NFG,F,GMAX,ITERM
      IF (IPRNT.LT.0) WRITE (6,'(1X,''X='',5(G14.7,1X):/(3X,5(G14.7,1X))
     &)') (X(I),I=1,NF)
      RETURN
      END
! SUBROUTINE PLIPU              ALL SYSTEMS                   97/01/22
! PURPOSE :
! EASY TO USE SUBROUTINE FOR LARGE-SCALE UNCONSTRAINED MINIMIZATION.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  RI  X(NF)  VECTOR OF VARIABLES.
!  II  IPAR(7)  INTEGER PAREMETERS:
!      IPAR(1)  MAXIMUM NUMBER OF ITERATIONS.
!      IPAR(2)  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!      IPAR(3)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIP.
!      IPAR(4)  ESTIMATION INDICATOR. IPAR(4)=0-MINIMUM IS NOT
!         ESTIMATED. IPAR(4)=1-MINIMUM IS ESTIMATED BY THE VALUE
!         RPAR(6).
!      IPAR(5)  METHOD USED. IPAR(5)=1-RANK-ONE METHOD.
!         IPAR(5)=2-RANK-TWO METHOD.
!      IPAR(6)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIP.
!      IPAR(7)  MAXIMUM NUMBER OF VARIABLE METRIC UPDATES.
!  RI  RPAR(9)  REAL PARAMETERS:
!      RPAR(1)  MAXIMUM STEPSIZE.
!      RPAR(2)  TOLERANCE FOR THE CHANGE OF VARIABLES.
!      RPAR(3)  TOLERANCE FOR THE CHANGE OF FUNCTION VALUES.
!      RPAR(4)  TOLERANCE FOR THE FUNCTION FALUE.
!      RPAR(5)  TOLERANCE FOR THE GRADIENT NORM.
!      RPAR(6)  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!      RPAR(7)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIP.
!      RPAR(8)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIP.
!      RPAR(9)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIP.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PLIP  LIMITED MEMORY SHIFTED VARIABLE METRIC METHOD IN THE
!            PRODUCT FORM.
!
! EXTERNAL SUBROUTINES :
!  SE  OBJ  COMPUTATION OF THE VALUE OF THE OBJECTIVE FUNCTION.
!         CALLING SEQUENCE: CALL OBJ(NF,X,FF) WHERE NF IS THE NUMBER
!         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND FF IS
!         THE VALUE OF THE OBJECTIVE FUNCTION.
!  SE  DOBJ  COMPUTATION OF THE GRADIENT OF THE OBJECTIVE FUNCTION.
!         CALLING SEQUENCE: CALL DOBJ(NF,X,GF) WHERE NF IS THE NUMBER
!         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND GF(NF)
!         IS THE GRADIENT OF THE OBJECTIVE FUNCTION.
!
      SUBROUTINE PLIPU (NF, X, IPAR, RPAR, F, GMAX, IPRNT, ITERM)
      INTEGER NF,IPAR(7),IPRNT,ITERM
      DOUBLE PRECISION X(*),RPAR(9),F,GMAX
      INTEGER MF,NB,LGF,LS,LXO,LGO,LSO,LXM,LXR,LGR
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      DOUBLE PRECISION RA(:)
      ALLOCATABLE RA
      MF=IPAR(7)
      IF (MF.LE.0) MF=10
      ALLOCATE (RA(5*NF+NF*MF+2*MF))
      NB=0
!
!     POINTERS FOR AUXILIARY ARRAYS
!
      LGF=1
      LS=LGF+NF
      LXO=LS+NF
      LGO=LXO+NF
      LSO=LGO+NF
      LXM=LSO+NF
      LXR=LXM+NF*MF
      LGR=LXR+MF
      CALL PLIP (NF, NB, X, IPAR, RA, RA, RA(LGF), RA(LS), RA(LXO),
     &RA(LGO), RA(LSO), RA(LXM), RA(LXR), RA(LGR), RPAR(1), RPAR(2),
     &RPAR(3), RPAR(4), RPAR(5), RPAR(6), GMAX, F, IPAR(1), IPAR(2),
     &IPAR(4), IPAR(5), MF, IPRNT, ITERM)
      DEALLOCATE (RA)
      RETURN
      END
! SUBROUTINE PLIPS              ALL SYSTEMS                   97/01/22
! PURPOSE :
! EASY TO USE SUBROUTINE FOR LARGE-SCALE BOX CONSTRAINED MINIMIZATION.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  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-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.
!  II  IPAR(7)  INTEGER PAREMETERS:
!      IPAR(1)  MAXIMUM NUMBER OF ITERATIONS.
!      IPAR(2)  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!      IPAR(3)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIP.
!      IPAR(4)  ESTIMATION INDICATOR. IPAR(4)=0-MINIMUM IS NOT
!         ESTIMATED. IPAR(4)=1-MINIMUM IS ESTIMATED BY THE VALUE
!         RPAR(6).
!      IPAR(5)  METHOD USED. IPAR(5)=1-RANK-ONE METHOD.
!         IPAR(5)=2-RANK-TWO METHOD.
!      IPAR(6)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIP.
!      IPAR(7)  MAXIMUM NUMBER OF VARIABLE METRIC UPDATES.
!  RI  RPAR(9)  REAL PARAMETERS:
!      RPAR(1)  MAXIMUM STEPSIZE.
!      RPAR(2)  TOLERANCE FOR THE CHANGE OF VARIABLES.
!      RPAR(3)  TOLERANCE FOR THE CHANGE OF FUNCTION VALUES.
!      RPAR(4)  TOLERANCE FOR THE FUNCTION FALUE.
!      RPAR(5)  TOLERANCE FOR THE GRADIENT NORM.
!      RPAR(6)  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!      RPAR(7)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIP.
!      RPAR(8)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIP.
!      RPAR(9)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIP.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PLIP  LIMITED MEMORY SHIFTED VARIABLE METRIC METHOD IN THE
!            PRODUCT FORM.
!
! EXTERNAL SUBROUTINES :
!  SE  OBJ  COMPUTATION OF THE VALUE OF THE OBJECTIVE FUNCTION.
!         CALLING SEQUENCE: CALL OBJ(NF,X,FF) WHERE NF IS THE NUMBER
!         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND FF IS
!         THE VALUE OF THE OBJECTIVE FUNCTION.
!  SE  DOBJ  COMPUTATION OF THE GRADIENT OF THE OBJECTIVE FUNCTION.
!         CALLING SEQUENCE: CALL DOBJ(NF,X,GF) WHERE NF IS THE NUMBER
!         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND GF(NF)
!         IS THE GRADIENT OF THE OBJECTIVE FUNCTION.
!
      SUBROUTINE PLIPS (NF, X, IX, XL, XU, IPAR, RPAR, F, GMAX, IPRNT,
     &ITERM)
      INTEGER NF,IX(*),IPAR(7),IPRNT,ITERM
      DOUBLE PRECISION X(*),XL(*),XU(*),RPAR(9),F,GMAX
      INTEGER MF,NB,LGF,LS,LXO,LGO,LSO,LXM,LXR,LGR
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      DOUBLE PRECISION RA(:)
      ALLOCATABLE RA
      MF=IPAR(7)
      IF (MF.LE.0) MF=10
      ALLOCATE (RA(5*NF+NF*MF+2*MF))
      NB=1
!
!     POINTERS FOR AUXILIARY ARRAYS
!
      LGF=1
      LS=LGF+NF
      LXO=LS+NF
      LGO=LXO+NF
      LSO=LGO+NF
      LXM=LSO+NF
      LXR=LXM+NF*MF
      LGR=LXR+MF
      CALL PLIP (NF, NB, X, IX, XL, XU, RA(LGF), RA(LS), RA(LXO),
     &RA(LGO), RA(LSO), RA(LXM), RA(LXR), RA(LGR), RPAR(1), RPAR(2),
     &RPAR(3), RPAR(4), RPAR(5), RPAR(6), GMAX, F, IPAR(1), IPAR(2),
     &IPAR(4), IPAR(5), MF, IPRNT, ITERM)
      DEALLOCATE (RA)
      RETURN
      END
! SUBROUTINE PLIP               ALL SYSTEMS                   01/09/22
! PURPOSE :
! GENERAL SUBROUTINE FOR LARGE-SCALE BOX CONSTRAINED MINIMIZATION THAT
! USE THE SHIFTED LIMITED MEMORY VARIABLE METRIC METHOD BASED ON THE
! PRODUCT FORM UPDATES.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  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.
!  RA  GF(NF)  GRADIENT OF THE OBJECTIVE FUNCTION.
!  RO  S(NF)  DIRECTION VECTOR.
!  RU  XO(NF)  VECTORS OF VARIABLES DIFFERENCE.
!  RI  GO(NF)  GRADIENTS DIFFERENCE.
!  RA  SO(NF)  AUXILIARY VECTOR.
!  RA  XM(NF*MF)  AUXILIARY VECTOR.
!  RA  XR(MF)  AUXILIARY VECTOR.
!  RA  GR(MF)  AUXILIARY VECTOR.
!  RI  XMAX  MAXIMUM STEPSIZE.
!  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 NORM.
!  RI  FMIN  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  II  MIT  MAXIMUM NUMBER OF ITERATIONS.
!  II  MFV  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!  II  IEST  ESTIMATION INDICATOR. IEST=0-MINIMUM IS NOT ESTIMATED.
!         IEST=1-MINIMUM IS ESTIMATED BY THE VALUE FMIN.
!  II  MET  METHOD USED. MET=1-RANK-ONE METHOD. MET=2-RANK-TWO
!         METHOD.
!  II  MF  NUMBER OF LIMITED MEMORY STEPS.
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUEBT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) SUBSEQUEBT ITERATIONS.
!         ITERM=3-IF F IS LESS THAN OR EQUAL TO TOLB.
!         ITERM=4-IF GMAX IS LESS THAN OR EQUAL TO TOLG.
!         ITERM=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITION.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PCBS04  ELIMINATION OF BOX CONSTRAINT VIOLATIONS.
!  S   PS1L01  STEPSIZE SELECTION USING LINE SEARCH.
!  S   PULSP3  SHIFTED VARIABLE METRIC UPDATE.
!  S   PULVP3  SHIFTED LIMITED-MEMORY VARIABLE METRIC UPDATE.
!  S   PYADC0  ADDITION OF A BOX CONSTRAINT.
!  S   PYFUT1  TEST ON TERMINATION.
!  S   PYRMC0  DELETION OF A BOX CONSTRAINT.
!  S   PYTRCD  COMPUTATION OF PROJECTED DIFFERENCES FOR THE VARIABLE MET
!         UPDATE.
!  S   PYTRCG  COMPUTATION OF THE PROJECTED GRADIENT.
!  S   PYTRCS  COMPUTATION OF THE PROJECTED DIRECTION VECTOR.
!  S   MXDRMM  MULTIPLICATION OF A ROWWISE STORED DENSE RECTANGULAR
!         MATRIX A BY A VECTOR X.
!  S   MXDCMD  MULTIPLICATION OF A COLUMNWISE STORED DENSE RECTANGULAR
!         MATRIX A BY A VECTOR X AND ADDITION OF THE SCALED VECTOR
!         ALF*Y.
!  S   MXUCOP  COPYING OF A VECTOR.
!  S   MXUDIR  VECTOR AUGMENTED BY THE SCALED VECTOR.
!  RF  MXUDOT  DOT PRODUCT OF TWO VECTORS.
!  S   MXUNEG  COPYING OF A VECTOR WITH CHANGE OF THE SIGN.
!  S   MXUZER  VECTOR ELEMENTS CORRESPONDING TO ACTIVE BOUNDS ARE SET
!         TO ZERO.
!  S   MXVCOP  COPYING OF A VECTOR.
!
! EXTERNAL SUBROUTINES :
!  SE  OBJ  COMPUTATION OF THE VALUE OF THE OBJECTIVE FUNCTION.
!         CALLING SEQUENCE: CALL OBJ(NF,X,FF) WHERE NF IS THE NUMBER
!         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND FF IS
!         THE VALUE OF THE OBJECTIVE FUNCTION.
!  SE  DOBJ  COMPUTATION OF THE GRADIENT OF THE OBJECTIVE FUNCTION.
!         CALLING SEQUENCE: CALL DOBJ(NF,X,GF) WHERE NF IS THE NUMBER
!         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND GF(NF)
!         IS THE GRADIENT OF THE OBJECTIVE FUNCTION.
!
! METHOD :
! HYBRID METHOD WITH SPARSE MARWIL UPDATES FOR SPARSE LEAST SQUARES
! PROBLEMS.
!
      SUBROUTINE PLIP (NF, NB, X, IX, XL, XU, GF, S, XO, GO, SO, XM, XR,
     & GR, XMAX, TOLX, TOLF, TOLB, TOLG, FMIN, GMAX, F, MIT, MFV, IEST,
     &MET, MF, IPRNT, ITERM)
      INTEGER NF,NB,IX(*),MIT,MFV,IEST,MET,MF,IPRNT,ITERM
      DOUBLE PRECISION X(*),XL(*),XU(*),GF(*),S(*),XO(*),GO(*),SO(*),
     &XM(*),XR(*),GR(*),XMAX,TOLX,TOLF,TOLG,TOLB,FMIN,GMAX,F
      INTEGER ITERD,ITERS,ITERH,KD,LD,NTESX,NTESF,MTESX,MTESF,MRED,KIT,
     &IREST,KBF,MEC,MES,MES1,MES2,MES3,MAXST,ISYS,ITES,INITS,KTERS,
     &IRES1,IRES2,NRED,INEW,IOLD,I,NN,N,MFG,META,MET3
      DOUBLE PRECISION R,RO,RP,FO,FP,P,PO,PP,GNORM,SNORM,RMIN,RMAX,UMAX,
     &FMAX,DMAX,ETA0,ETA9,EPS8,EPS9,ALF1,ALF2,PAR1,PAR2,PAR,TOLD,TOLS,
     &TOLP
      DOUBLE PRECISION MXUDOT
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      IF (ABS(IPRNT).GT.1) WRITE (6,'(1X,''ENTRY TO PLIP :'')')
!
!     INITIATION
!
      KBF=0
      IF (NB.GT.0) KBF=2
      NRES=0
      NDEC=0
      NIN=0
      NIT=0
      NFV=0
      NFG=0
      NFH=0
      ISYS=0
      ITES=1
      MTESX=2
      MTESF=2
      INITS=2
      ITERM=0
      ITERD=0
      ITERS=2
      ITERH=0
      KTERS=3
      IREST=0
      IRES1=999
      IRES2=0
      MRED=10
      META=1
      MET3=4
      MEC=4
      MES=4
      MES1=2
      MES2=2
      MES3=2
      ETA0=1.0D-15
      ETA9=1.0D120
      EPS8=1.00D0
      EPS9=1.00D-8
      ALF1=1.0D-10
      ALF2=1.0D10
      RMAX=ETA9
      DMAX=ETA9
      FMAX=1.0D20
      IF (IEST.LE.0) FMIN=-1.0D60
      IF (IEST.GT.0) IEST=1
      IF (XMAX.LE.0.0D0) XMAX=1.0D16
      IF (TOLX.LE.0.0D0) TOLX=1.0D-16
      IF (TOLF.LE.0.0D0) TOLF=1.0D-14
      IF (TOLG.LE.0.0D0) TOLG=1.0D-6
      IF (TOLB.LE.0.0D0) TOLB=FMIN+1.0D-16
      TOLD=1.0D-4
      TOLS=1.0D-4
      TOLP=0.9D0
      IF (MET.LE.0) MET=2
      IF (MIT.LE.0) MIT=9000
      IF (MFV.LE.0) MFV=9000
      MFG=MFV
      KD=1
      LD=-1
      KIT=-(IRES1*NF+IRES2)
      FO=FMIN
!
!     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
   10   CONTINUE
        CALL PCBS04 (NF, X, IX, XL, XU, EPS9, KBF)
        CALL PYADC0 (NF, N, X, IX, XL, XU, INEW)
      END IF
      IF (ITERM.NE.0) GO TO 70
      CALL OBJ (NF, X, F)
      NFV=NFV+1
      CALL DOBJ (NF, X, GF)
      NFG=NFG+1
   20 CALL PYTRCG (NF, NF, IX, GF, UMAX, GMAX, KBF, IOLD)
      IF (ABS(IPRNT).GT.1) WRITE (6,'(1X,''NIT='',I5,2X,''NFV='',I5,2X,'
     &'NFG='',I5,2X,''F='',G16.9,2X,''G='',E10.3)') NIT,NFV,NFG,F,GMAX
      CALL PYFUT1 (NF, F, FO, UMAX, GMAX, DMAX, TOLX, TOLF, TOLB, TOLG,
     &KD, NIT, KIT, MIT, NFV, MFV, NFG, MFG, NTESX, MTESX, NTESF, MTESF,
     &ITES, IRES1, IRES2, IREST, ITERS, ITERM)
      IF (ITERM.NE.0) GO TO 70
      IF (KBF.GT.0.AND.RMAX.GT.0.0D0) THEN
        CALL PYRMC0 (NF, N, IX, GF, EPS8, UMAX, GMAX, RMAX, IOLD, IREST)
      END IF
   30 IF (IREST.GT.0) THEN
        NN=0
        PAR=1.0D0
        LD=MIN(LD,1)
        IF (KIT.LT.NIT) THEN
          NRES=NRES+1
          KIT=NIT
        ELSE
          ITERM=-10
          IF (ITERS.LT.0) ITERM=ITERS-5
        END IF
      END IF
      IF (ITERM.NE.0) GO TO 70
!
!     DIRECTION DETERMINATION
!
      GNORM=SQRT(MXUDOT(NF,GF,GF,IX,KBF))
!
!     NEWTON LIKE STEP
!
      CALL MXUNEG (NF, GF, S, IX, KBF)
      CALL MXDRMM (NF, NN, XM, S, GR)
      CALL MXDCMD (NF, NN, XM, GR, PAR, S, S)
      CALL MXUZER (NF, S, IX, KBF)
      ITERD=1
      SNORM=SQRT(MXUDOT(NF,S,S,IX,KBF))
!
!     TEST ON DESCENT DIRECTION AND PREPARATION OF LINE SEARCH
!
      IF (KD.GT.0) P=MXUDOT(NF,GF,S,IX,KBF)
      IF (ITERD.LT.0) THEN
        ITERM=ITERD
      ELSE
!
!     TEST ON DESCENT DIRECTION
!
        IF (SNORM.LE.0.0D0) THEN
          IREST=MAX(IREST,1)
        ELSE IF (P+TOLD*GNORM*SNORM.LE.0.0D0) THEN
          IREST=0
        ELSE
!
!     UNIFORM DESCENT CRITERION
!
          IREST=MAX(IREST,1)
        END IF
        IF (IREST.EQ.0) THEN
!
!     PREPARATION OF LINE SEARCH
!
          NRED=0
          RMIN=ALF1*GNORM/SNORM
          RMAX=MIN(ALF2*GNORM/SNORM,XMAX/SNORM)
        END IF
      END IF
      IF (ITERM.NE.0) GO TO 70
      IF (IREST.NE.0) GO TO 30
      CALL PYTRCS (NF, X, IX, XO, XL, XU, GF, GO, S, RO, FP, FO, F, PO,
     &P, RMAX, ETA9, KBF)
      IF (RMAX.EQ.0.0D0) GO TO 60
   40 CALL PS1L01 (R, RP, F, FO, FP, P, PO, PP, FMIN, FMAX, RMIN, RMAX,
     &TOLS, TOLP, PAR1, PAR2, KD, LD, NIT, KIT, NRED, MRED, MAXST, IEST,
     &INITS, ITERS, KTERS, MES, ISYS)
      IF (ISYS.EQ.0) GO TO 50
      CALL MXUDIR (NF, R, S, XO, X, IX, KBF)
      CALL PCBS04 (NF, X, IX, XL, XU, EPS9, KBF)
      CALL OBJ (NF, X, F)
      NFV=NFV+1
      CALL DOBJ (NF, X, GF)
      NFG=NFG+1
      P=MXUDOT(NF,GF,S,IX,KBF)
      GO TO 40
   50 CONTINUE
      IF (ITERS.LE.0) THEN
        R=0.0D0
        F=FO
        P=PO
        CALL MXVCOP (NF, XO, X)
        CALL MXVCOP (NF, GO, GF)
        IREST=MAX(IREST,1)
        LD=KD
        GO TO 30
      END IF
      CALL MXUNEG (NF, GO, S, IX, KBF)
      CALL PYTRCD (NF, X, IX, XO, GF, GO, R, F, FO, P, PO, DMAX, KBF,
     &KD, LD, ITERS)
      CALL MXUCOP (NF, GF, SO, IX, KBF)
      IF (NN.LT.MF) THEN
        CALL PULSP3 (NF, NN, MF, XM, GR, XO, GO, R, PO, PAR, ITERH,
     &   MET3)
      ELSE
        CALL PULVP3 (NF, NN, XM, XR, GR, S, SO, XO, GO, R, PO, PAR,
     &   ITERH, MEC, MET3, MET)
      END IF
   60 CONTINUE
      IF (ITERH.NE.0) IREST=MAX(IREST,1)
      IF (KBF.GT.0) CALL PYADC0 (NF, N, X, IX, XL, XU, INEW)
      GO TO 20
   70 CONTINUE
      IF (IPRNT.GT.1.OR.IPRNT.LT.0) WRITE (6,'(1X,''EXIT FROM PLIP :'')'
     &)
      IF (IPRNT.NE.0) WRITE (6,'(1X,''NIT='',I5,2X,''NFV='',I5,2X,''NFG=
     &'',I5,2X,''F='',G16.9,2X,''G='',E10.3,2X,''ITERM='',I3)')
     &NIT,NFV,NFG,F,GMAX,ITERM
      IF (IPRNT.LT.0) WRITE (6,'(1X,''X='',5(G14.7,1X):/(3X,5(G14.7,1X))
     &)') (X(I),I=1,NF)
      RETURN
      END
! SUBROUTINE PLISU              ALL SYSTEMS                   97/01/22
! PURPOSE :
! EASY TO USE SUBROUTINE FOR LARGE-SCALE UNCONSTRAINED MINIMIZATION.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  RI  X(NF)  VECTOR OF VARIABLES.
!  II  IPAR(7)  INTEGER PAREMETERS:
!      IPAR(1)  MAXIMUM NUMBER OF ITERATIONS.
!      IPAR(2)  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!      IPAR(3)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIS.
!      IPAR(4)  ESTIMATION INDICATOR. IPAR(4)=0-MINIMUM IS NOT
!         ESTIMATED. IPAR(4)=1-MINIMUM IS ESTIMATED BY THE VALUE
!         RPAR(6).
!      IPAR(5)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIS.
!      IPAR(6)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIS.
!      IPAR(7)  MAXIMUM NUMBER OF VARIABLE METRIC UPDATES.
!  RI  RPAR(9)  REAL PARAMETERS:
!      RPAR(1)  MAXIMUM STEPSIZE.
!      RPAR(2)  TOLERANCE FOR THE CHANGE OF VARIABLES.
!      RPAR(3)  TOLERANCE FOR THE CHANGE OF FUNCTION VALUES.
!      RPAR(4)  TOLERANCE FOR THE FUNCTION FALUE.
!      RPAR(5)  TOLERANCE FOR THE GRADIENT NORM.
!      RPAR(6)  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!      RPAR(7)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIS.
!      RPAR(8)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIS.
!      RPAR(9)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIS.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PLIS  LIMITED MEMORY VARIABLE METRIC METHOD BASED ON THE STRANG
!         RECURRENCES.
!
! EXTERNAL SUBROUTINES :
!  SE  OBJ  COMPUTATION OF THE VALUE OF THE OBJECTIVE FUNCTION.
!         CALLING SEQUENCE: CALL OBJ(NF,X,FF) WHERE NF IS THE NUMBER
!         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND FF IS
!         THE VALUE OF THE OBJECTIVE FUNCTION.
!  SE  DOBJ  COMPUTATION OF THE GRADIENT OF THE OBJECTIVE FUNCTION.
!         CALLING SEQUENCE: CALL DOBJ(NF,X,GF) WHERE NF IS THE NUMBER
!         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND GF(NF)
!         IS THE GRADIENT OF THE OBJECTIVE FUNCTION.
!
      SUBROUTINE PLISU (NF, X, IPAR, RPAR, F, GMAX, IPRNT, ITERM)
      INTEGER NF,IPAR(7),IPRNT,ITERM
      DOUBLE PRECISION X(*),RPAR(9),F,GMAX
      INTEGER MF,NB,LGF,LS,LXO,LGO,LUO,LVO
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      DOUBLE PRECISION RA(:)
      ALLOCATABLE RA
      MF=IPAR(7)
      IF (MF.LE.0) MF=10
      ALLOCATE (RA(2*NF+2*NF*MF+2*MF))
      NB=0
!
!     POINTERS FOR AUXILIARY ARRAYS
!
      LGF=1
      LS=LGF+NF
      LXO=LS+NF
      LGO=LXO+NF*MF
      LUO=LGO+NF*MF
      LVO=LUO+MF
      CALL PLIS (NF, NB, X, IPAR, RA, RA, RA(LGF), RA(LS), RA(LXO),
     &RA(LGO), RA(LUO), RA(LVO), RPAR(1), RPAR(2), RPAR(3), RPAR(4),
     &RPAR(5), RPAR(6), GMAX, F, IPAR(1), IPAR(2), IPAR(4), MF, IPRNT,
     &ITERM)
      DEALLOCATE (RA)
      RETURN
      END
! SUBROUTINE PLISS              ALL SYSTEMS                   97/01/22
! PURPOSE :
! EASY TO USE SUBROUTINE FOR LARGE-SCALE BOX CONSTRAINED MINIMIZATION.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  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-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.
!  II  IPAR(7)  INTEGER PAREMETERS:
!      IPAR(1)  MAXIMUM NUMBER OF ITERATIONS.
!      IPAR(2)  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!      IPAR(3)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIS.
!      IPAR(4)  ESTIMATION INDICATOR. IPAR(4)=0-MINIMUM IS NOT
!         ESTIMATED. IPAR(4)=1-MINIMUM IS ESTIMATED BY THE VALUE
!         RPAR(6).
!      IPAR(5)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIS.
!      IPAR(6)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIS.
!      IPAR(7)  MAXIMUM NUMBER OF VARIABLE METRIC UPDATES.
!  RI  RPAR(9)  REAL PARAMETERS:
!      RPAR(1)  MAXIMUM STEPSIZE.
!      RPAR(2)  TOLERANCE FOR THE CHANGE OF VARIABLES.
!      RPAR(3)  TOLERANCE FOR THE CHANGE OF FUNCTION VALUES.
!      RPAR(4)  TOLERANCE FOR THE FUNCTION FALUE.
!      RPAR(5)  TOLERANCE FOR THE GRADIENT NORM.
!      RPAR(6)  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!      RPAR(7)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIS.
!      RPAR(8)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIS.
!      RPAR(9)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIS.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PLIS  LIMITED MEMORY VARIABLE METRIC METHOD BASED ON THE STRANG
!         RECURRENCES.
!
! EXTERNAL SUBROUTINES :
!  SE  OBJ  COMPUTATION OF THE VALUE OF THE OBJECTIVE FUNCTION.
!         CALLING SEQUENCE: CALL OBJ(NF,X,FF) WHERE NF IS THE NUMBER
!         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND FF IS
!         THE VALUE OF THE OBJECTIVE FUNCTION.
!  SE  DOBJ  COMPUTATION OF THE GRADIENT OF THE OBJECTIVE FUNCTION.
!         CALLING SEQUENCE: CALL DOBJ(NF,X,GF) WHERE NF IS THE NUMBER
!         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND GF(NF)
!         IS THE GRADIENT OF THE OBJECTIVE FUNCTION.
!
      SUBROUTINE PLISS (NF, X, IX, XL, XU, IPAR, RPAR, F, GMAX, IPRNT,
     &ITERM)
      INTEGER NF,IX(*),IPAR(7),IPRNT,ITERM
      DOUBLE PRECISION X(*),XL(*),XU(*),RPAR(9),F,GMAX
      INTEGER MF,NB,LGF,LS,LXO,LGO,LUO,LVO
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      DOUBLE PRECISION RA(:)
      ALLOCATABLE RA
      MF=IPAR(7)
      IF (MF.LE.0) MF=10
      ALLOCATE (RA(2*NF+2*NF*MF+2*MF))
      NB=1
!
!     POINTERS FOR AUXILIARY ARRAYS
!
      LGF=1
      LS=LGF+NF
      LXO=LS+NF
      LGO=LXO+NF*MF
      LUO=LGO+NF*MF
      LVO=LUO+MF
      CALL PLIS (NF, NB, X, IX, XL, XU, RA(LGF), RA(LS), RA(LXO),
     &RA(LGO), RA(LUO), RA(LVO), RPAR(1), RPAR(2), RPAR(3), RPAR(4),
     &RPAR(5), RPAR(6), GMAX, F, IPAR(1), IPAR(2), IPAR(4), MF, IPRNT,
     &ITERM)
      DEALLOCATE (RA)
      RETURN
      END
! SUBROUTINE PLIS               ALL SYSTEMS                   01/09/22
! PURPOSE :
! GENERAL SUBROUTINE FOR LARGE-SCALE BOX CONSTRAINED MINIMIZATION THAT
! USE THE LIMITED MEMORY VARIABLE METRIC METHOD BASED ON THE STRANG
! RECURRENCES.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  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  GF(NF)  GRADIENT OF THE OBJECTIVE FUNCTION.
!  RO  S(NF)  DIRECTION VECTOR.
!  RU  XO(NF)  VECTORS OF VARIABLES DIFFERENCE.
!  RI  GO(NF)  GRADIENTS DIFFERENCE.
!  RA  UO(NF)  AUXILIARY VECTOR.
!  RA  VO(NF)  AUXILIARY VECTOR.
!  RI  XMAX  MAXIMUM STEPSIZE.
!  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 NORM.
!  RI  FMIN  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  II  MIT  MAXIMUM NUMBER OF ITERATIONS.
!  II  MFV  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!  II  IEST  ESTIMATION INDICATOR. IEST=0-MINIMUM IS NOT ESTIMATED.
!         IEST=1-MINIMUM IS ESTIMATED BY THE VALUE FMIN.
!  II  MF  NUMBER OF LIMITED MEMORY STEPS.
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUEBT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) SUBSEQUEBT ITERATIONS.
!         ITERM=3-IF F IS LESS THAN OR EQUAL TO TOLB.
!         ITERM=4-IF GMAX IS LESS THAN OR EQUAL TO TOLG.
!         ITERM=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITION.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PCBS04  ELIMINATION OF BOX CONSTRAINT VIOLATIONS.
!  S   PS1L01  STEPSIZE SELECTION USING LINE SEARCH.
!  S   PYADC0  ADDITION OF A BOX CONSTRAINT.
!  S   PYFUT1  TEST ON TERMINATION.
!  S   PYRMC0  DELETION OF A BOX CONSTRAINT.
!  S   PYTRCD  COMPUTATION OF PROJECTED DIFFERENCES FOR THE VARIABLE MET
!         UPDATE.
!  S   PYTRCG  COMPUTATION OF THE PROJECTED GRADIENT.
!  S   PYTRCS  COMPUTATION OF THE PROJECTED DIRECTION VECTOR.
!  S   MXDRCB BACKWARD PART OF THE STRANG FORMULA FOR PREMULTIPLICATION
!         OF THE VECTOR X BY AN IMPLICIT BFGS UPDATE.
!  S   MXDRCF FORWARD PART OF THE STRANG FORMULA FOR PREMULTIPLICATION
!         OF THE VECTOR X BY AN IMPLICIT BFGS UPDATE.
!  S   MXDRSU SHIFT OF COLUMNS OF THE RECTANGULAR MATRICES A AND B.
!         SHIFT OF ELEMENTS OF THE VECTOR U. THESE SHIFTS ARE USED IN
!         THE LIMITED MEMORY BFGS METHOD.
!  S   MXUDIR  VECTOR AUGMENTED BY THE SCALED VECTOR.
!  RF  MXUDOT  DOT PRODUCT OF TWO VECTORS.
!  S   MXUNEG  COPYING OF A VECTOR WITH CHANGE OF THE SIGN.
!  S   MXVCOP  COPYING OF A VECTOR.
!  S   MXVSCL  SCALING OF A VECTOR.
!
! EXTERNAL SUBROUTINES :
!  SE  OBJ  COMPUTATION OF THE VALUE OF THE OBJECTIVE FUNCTION.
!         CALLING SEQUENCE: CALL OBJ(NF,X,FF) WHERE NF IS THE NUMBER
!         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND FF IS
!         THE VALUE OF THE OBJECTIVE FUNCTION.
!  SE  DOBJ  COMPUTATION OF THE GRADIENT OF THE OBJECTIVE FUNCTION.
!         CALLING SEQUENCE: CALL DOBJ(NF,X,GF) WHERE NF IS THE NUMBER
!         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND GF(NF)
!         IS THE GRADIENT OF THE OBJECTIVE FUNCTION.
!
! METHOD :
! LIMITED MEMORY VARIABLE METRIC METHOD BASED ON THE STRANG
! RECURRENCES.
!
      SUBROUTINE PLIS (NF, NB, X, IX, XL, XU, GF, S, XO, GO, UO, VO,
     &XMAX, TOLX, TOLF, TOLB, TOLG, FMIN, GMAX, F, MIT, MFV, IEST, MF,
     &IPRNT, ITERM)
      INTEGER NF,NB,IX(*),MIT,MFV,IEST,MF,IPRNT,ITERM
      DOUBLE PRECISION X(*),XL(*),XU(*),GF(*),S(*),XO(*),GO(*),UO(*),
     &VO(*),TOLX,TOLF,TOLG,TOLB,FMIN,XMAX,GMAX,F
      INTEGER ITERD,ITERS,KD,LD,NTESX,NTESF,MTESX,MTESF,MRED,KIT,IREST,
     &KBF,MES,MES1,MES2,MES3,MAXST,ISYS,ITES,INITS,KTERS,IRES1,IRES2,
     &INEW,IOLD,I,N,MFG,K,NRED
      DOUBLE PRECISION R,RO,RP,FO,FP,P,PO,PP,GNORM,SNORM,RMIN,RMAX,UMAX,
     &FMAX,DMAX,ETA0,ETA9,EPS8,EPS9,ALF1,ALF2,PAR1,PAR2,A,B,TOLD,TOLS,
     &TOLP
      DOUBLE PRECISION MXUDOT
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      IF (ABS(IPRNT).GT.1) WRITE (6,'(1X,''ENTRY TO PLIS :'')')
!
!     INITIATION
!
      KBF=0
      IF (NB.GT.0) KBF=2
      NRES=0
      NDEC=0
      NIN=0
      NIT=0
      NFV=0
      NFG=0
      NFH=0
      ISYS=0
      ITES=1
      MTESX=2
      MTESF=2
      INITS=2
      ITERM=0
      ITERD=0
      ITERS=2
      KTERS=3
      IREST=0
      IRES1=999
      IRES2=0
      MRED=10
      MES=4
      MES1=2
      MES2=2
      MES3=2
      ETA0=1.0D-15
      ETA9=1.0D120
      EPS8=1.00D0
      EPS9=1.00D-8
      ALF1=1.0D-10
      ALF2=1.0D10
      RMAX=ETA9
      DMAX=ETA9
      FMAX=1.0D20
      IF (IEST.LE.0) FMIN=-1.0D60
      IF (IEST.GT.0) IEST=1
      IF (XMAX.LE.0.0D0) XMAX=1.0D16
      IF (TOLX.LE.0.0D0) TOLX=1.0D-16
      IF (TOLF.LE.0.0D0) TOLF=1.0D-14
      IF (TOLG.LE.0.0D0) TOLG=1.0D-6
      IF (TOLB.LE.0.0D0) TOLB=FMIN+1.0D-16
      TOLD=1.0D-4
      TOLS=1.0D-4
      TOLP=0.8D0
      IF (MIT.LE.0) MIT=9000
      IF (MFV.LE.0) MFV=9000
      MFG=MFV
      KD=1
      LD=-1
      KIT=-(IRES1*NF+IRES2)
      FO=FMIN
!
!     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
   10   CONTINUE
        CALL PCBS04 (NF, X, IX, XL, XU, EPS9, KBF)
        CALL PYADC0 (NF, N, X, IX, XL, XU, INEW)
      END IF
      IF (ITERM.NE.0) GO TO 80
      CALL OBJ (NF, X, F)
      NFV=NFV+1
      CALL DOBJ (NF, X, GF)
      NFG=NFG+1
   20 CALL PYTRCG (NF, NF, IX, GF, UMAX, GMAX, KBF, IOLD)
      IF (ABS(IPRNT).GT.1) WRITE (6,'(1X,''NIT='',I5,2X,''NFV='',I5,2X,'
     &'NFG='',I5,2X,''F='',G16.9,2X,''G='',E10.3)') NIT,NFV,NFG,F,GMAX
      CALL PYFUT1 (NF, F, FO, UMAX, GMAX, DMAX, TOLX, TOLF, TOLB, TOLG,
     &KD, NIT, KIT, MIT, NFV, MFV, NFG, MFG, NTESX, MTESX, NTESF, MTESF,
     &ITES, IRES1, IRES2, IREST, ITERS, ITERM)
      IF (ITERM.NE.0) GO TO 80
      IF (KBF.GT.0.AND.RMAX.GT.0.0D0) THEN
        CALL PYRMC0 (NF, N, IX, GF, EPS8, UMAX, GMAX, RMAX, IOLD, IREST)
      END IF
!
!     DIRECTION DETERMINATION
!
   30 GNORM=SQRT(MXUDOT(NF,GF,GF,IX,KBF))
      IF (IREST.NE.0) GO TO 40
      K=MIN(NIT-KIT,MF)
      IF (K.LE.0) THEN
        IREST=MAX(IREST,1)
        GO TO 40
      END IF
!
!     DETERMINATION OF THE PARAMETER B
!
      B=MXUDOT(NF,XO,GO,IX,KBF)
      IF (B.LE.0.0D0) THEN
        IREST=MAX(IREST,1)
        GO TO 40
      END IF
      UO(1)=1.0D0/B
      CALL MXUNEG (NF, GF, S, IX, KBF)
      CALL MXDRCB (NF, K, XO, GO, UO, VO, S, IX, KBF)
      A=MXUDOT(NF,GO,GO,IX,KBF)
      IF (A.GT.0.0D0) THEN
        CALL MXVSCL (NF, B/A, S, S)
      END IF
      CALL MXDRCF (NF, K, XO, GO, UO, VO, S, IX, KBF)
      SNORM=SQRT(MXUDOT(NF,S,S,IX,KBF))
      K=MIN(K+1,MF)
      CALL MXDRSU (NF, K, XO, GO, UO)
   40 CONTINUE
      ITERD=0
      IF (IREST.NE.0) THEN
!
!     STEEPEST DESCENT DIRECTION
!
        CALL MXUNEG (NF, GF, S, IX, KBF)
        SNORM=GNORM
        IF (KIT.LT.NIT) THEN
          NRES=NRES+1
          KIT=NIT
        ELSE
          ITERM=-10
          IF (ITERS.LT.0) ITERM=ITERS-5
        END IF
      END IF
!
!     TEST ON DESCENT DIRECTION AND PREPARATION OF LINE SEARCH
!
      IF (KD.GT.0) P=MXUDOT(NF,GF,S,IX,KBF)
      IF (ITERD.LT.0) THEN
        ITERM=ITERD
      ELSE
!
!     TEST ON DESCENT DIRECTION
!
        IF (SNORM.LE.0.0D0) THEN
          IREST=MAX(IREST,1)
        ELSE IF (P+TOLD*GNORM*SNORM.LE.0.0D0) THEN
          IREST=0
        ELSE
!
!     UNIFORM DESCENT CRITERION
!
          IREST=MAX(IREST,1)
        END IF
        IF (IREST.EQ.0) THEN
!
!     PREPARATION OF LINE SEARCH
!
          NRED=0
          RMIN=ALF1*GNORM/SNORM
          RMAX=MIN(ALF2*GNORM/SNORM,XMAX/SNORM)
        END IF
      END IF
      IF (ITERM.NE.0) GO TO 80
      IF (IREST.NE.0) GO TO 30
      CALL PYTRCS (NF, X, IX, XO, XL, XU, GF, GO, S, RO, FP, FO, F, PO,
     &P, RMAX, ETA9, KBF)
      IF (RMAX.EQ.0.0D0) GO TO 70
   50 CALL PS1L01 (R, RP, F, FO, FP, P, PO, PP, FMIN, FMAX, RMIN, RMAX,
     &TOLS, TOLP, PAR1, PAR2, KD, LD, NIT, KIT, NRED, MRED, MAXST, IEST,
     &INITS, ITERS, KTERS, MES, ISYS)
      IF (ISYS.EQ.0) GO TO 60
      CALL MXUDIR (NF, R, S, XO, X, IX, KBF)
      CALL PCBS04 (NF, X, IX, XL, XU, EPS9, KBF)
      CALL OBJ (NF, X, F)
      NFV=NFV+1
      CALL DOBJ (NF, X, GF)
      NFG=NFG+1
      P=MXUDOT(NF,GF,S,IX,KBF)
      GO TO 50
   60 CONTINUE
      IF (ITERS.LE.0) THEN
        R=0.0D0
        F=FO
        P=PO
        CALL MXVCOP (NF, XO, X)
        CALL MXVCOP (NF, GO, GF)
        IREST=MAX(IREST,1)
        LD=KD
        GO TO 30
      END IF
      CALL PYTRCD (NF, X, IX, XO, GF, GO, R, F, FO, P, PO, DMAX, KBF,
     &KD, LD, ITERS)
   70 CONTINUE
      IF (KBF.GT.0) THEN
        CALL MXVINE (NF, IX)
        CALL PYADC0 (NF, N, X, IX, XL, XU, INEW)
      END IF
      GO TO 20
   80 CONTINUE
      IF (IPRNT.GT.1.OR.IPRNT.LT.0) WRITE (6,'(1X,''EXIT FROM PLIS :'')'
     &)
      IF (IPRNT.NE.0) WRITE (6,'(1X,''NIT='',I5,2X,''NFV='',I5,2X,''NFG=
     &'',I5,2X,''F='',G16.9,2X,''G='',E10.3,2X,''ITERM='',I3)')
     &NIT,NFV,NFG,F,GMAX,ITERM
      IF (IPRNT.LT.0) WRITE (6,'(1X,''X='',5(G14.7,1X):/(3X,5(G14.7,1X))
     &)') (X(I),I=1,NF)
      RETURN
      END
! SUBROUTINE PMAXU              ALL SYSTEMS                   97/01/22
! PURPOSE :
! EASY TO USE SUBROUTINE FOR LARGE-SCALE UNCONSTRAINED MINIMAX
! OPTIMIZATION WITH SPARSE JACOBIAN MATRICES.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  II  NA  NUMBER OF PARTIAL FUNCTIONS.
!  IU  MA  NUMBER OF NONZERO ELEMENTS IN THE JACOBIAN MATRIX.
!  RI  X(NF)  VECTOR OF VARIABLES.
!  RO  AF(NA)  VECTOR CONTAINING VALUES OF PARTIAL FUNCTIONS.
!  RI  IAG(NA+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE JACOBIAN
!         MATRIX.
!  RI  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE JACOBIAN MATRIX.
!  II  IPAR(7)  INTEGER PAREMETERS:
!      IPAR(1)  MAXIMUM NUMBER OF ITERATIONS.
!      IPAR(2)  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!      IPAR(3)  MAXIMUM NUMBER OF GRADIENT EVALUATIONS.
!      IPAR(4)  ESTIMATION INDICATOR. IPAR(4)=0-MINIMUM IS NOT
!         ESTIMATED. IPAR(4)=1-MINIMUM IS ESTIMATED BY THE VALUE
!         RPAR(6).
!      IPAR(5)  METHOD USED. IPAR(5)=1-PARTITIONED VARIABLE METRIC
!         METHOD. IPAR(5)=2-DISCRETE NEWTON METHOD.
!      IPAR(6)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PMAX.
!      IPAR(7)  NUMBER DEFINING THE SPACE FOR FILL-IN (THE SIZE OF THIS
!         SPACE IS IFIL TIMES THE STANDARD SIZE). THE DEFAULT VALUE IS
!         IFIL=1. THE DEFAULT VALUE HAS TO BE INCREASED IF ITERM IS
!         LESS OR EQUAL TO -40.
!  RI  RPAR(9)  REAL PARAMETERS:
!      RPAR(1)  MAXIMUM STEPSIZE.
!      RPAR(2)  TOLERANCE FOR THE CHANGE OF VARIABLES.
!      RPAR(3)  TOLERANCE FOR THE CHANGE OF FUNCTION VALUES.
!      RPAR(4)  TOLERANCE FOR THE FUNCTION FALUE.
!      RPAR(5)  TOLERANCE FOR THE GRADIENT NORM.
!      RPAR(6)  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!      RPAR(7)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PMAX.
!      RPAR(8)  COEFFICIENT FOR THE BARRIER PARAMETER DECREASE.
!      RPAR(9)  MINIMUM PERMITTED VALUE OF THE BARRIER PARAMETER.
!  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.
!  II  ISPAS  INPUT SPARSE STRUCTURE. ISPAS=1-STANDARD COORDINATE
!         FORM. ISPAS=2-SPARSE STRUCTURE COMPRESSED BY ROWS.
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!         VALUES ITERM<=-40 DETECT A LACK OF SPACE. IN THIS CASE,
!         PARAMETER IPAR(7) HAS TO BE INCREASED.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PMAX  PRIMAL LINE-SEARCH INTERIOR-POINT METHOD FOR LARGE-SCALE
!         PARTIALLY SEPARABLE MINIMAX OPTIMIZATION PROBLEMS.
!  S   PASED3  COMPRESSED SPARSE STRUCTURE OF THE JACOBIAN MATRIX IS
!         COMPUTED FROM THE COORDINATE FORM.
!  S   PFSET2  NUMBER OF NONZERO ELEMENTS IN THE PARTITIONED HESSIAN
!         MATRIX.
!
! EXTERNAL SUBROUTINES :
!  SE  FUN  COMPUTATION 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  DFUN  COMPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION.
!         CALLING SEQUENCE: CALL DFUN(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 PMAXU (NF, NA, MA, X, AF, IAG, JAG, IPAR, RPAR, F,
     &GMAX, IEXT, ISPAS, IPRNT, ITERM)
      INTEGER NF,NA,MA,IAG(*),JAG(*),IPAR(7),IEXT,ISPAS,IPRNT,ITERM
      DOUBLE PRECISION X(*),AF(*),RPAR(9),F,GMAX
      INTEGER LAFO,LAG,LAGO,LGA,LAH,LAZL,LAZU,LG,LH,LS,LXO,LGO,LGS,LGP,
     &LIH,LJH,LCOL,LPSL,LPERM,LINVP,LWN11,LWN12,LWN13,LWN14,MB,MC
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH,IFIL,IER
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      INTEGER IA(:)
      DOUBLE PRECISION RA(:)
      ALLOCATABLE IA,RA
      IFIL=IPAR(7)
      IF (IFIL.LE.0) IFIL=1
      IF (ISPAS.LE.1) THEN
        CALL PASED3 (NF, NA, MA, IAG, JAG, IER)
        IF (IER.NE.0) THEN
          WRITE (6,'(''INPUT ERROR : IER = '',I3)') IER
          STOP
        END IF
      ELSE
        MA=IAG(NA+1)-1
      END IF
      CALL PFSET2 (NA, MB, MC, IAG)
      ALLOCATE(IA(NA+9*NF+7+(IFIL+3)*MB))
      IF (IPAR(5).LE.1) THEN
        ALLOCATE(RA(2*MA+3*NA+7*NF+7+(IFIL+4)*MB))
      ELSE
        ALLOCATE(RA(MA+3*NA+7*NF+7+(IFIL+3)*MB))
      END IF
!
!     POINTERS FOR AUXILIARY ARRAYS
!
      LAFO=1
      LAG=LAFO+NA
      IF (IPAR(5).LE.1) THEN
        LAGO=LAG+MA
        LAH=LAGO+MA
        LGA=LAH+MB
      ELSE
        LAGO=LAG
        LAH=LAG
        LGA=LAG+MA
      END IF
      LAZL=LGA+NF
      LAZU=LAZL+NA
      LG=LAZU+NA
      LS=LG+NF+1
      LXO=LS+NF+1
      LGO=LXO+NF+1
      LGS=LGO+NF+1
      LGP=LGS+NF+1
      LH=LGP+NF+1
      LCOL=NA+1
      LPSL=LCOL+NF
      LPERM=LPSL+NF+1
      LINVP=LPERM+NF
      LWN11=LINVP+NF
      LWN12=LWN11+NF+1
      LWN13=LWN12+NF+1
      LWN14=LWN13+NF+1
      LIH=LWN14+NF+1
      LJH=LIH+NF+2
      CALL PMAX (NF, NA, (IFIL+3)*MB, X, IA, AF, RA(LAFO), RA(LAG),
     &RA(LAGO), RA(LGA), RA(LAH), RA(LAZL), RA(LAZU), RA(LG), RA(LH),
     &IA(LIH), IA(LJH), IA, IAG, JAG, RA(LS), RA(LXO), RA(LGO), RA(LGS),
     & RA(LGP), IA(LCOL), IA(LPSL), IA(LPERM), IA(LINVP), IA(LWN11),
     &IA(LWN12), IA(LWN13), IA(LWN14), RPAR(1), RPAR(2), RPAR(3),
     &RPAR(4), RPAR(5), RPAR(6), RPAR(8), RPAR(9), GMAX, F, IPAR(1),
     &IPAR(2), IPAR(3), IPAR(4), IPAR(5), IEXT, IPRNT, ITERM)
      DEALLOCATE(IA,RA)
      RETURN
      END
! SUBROUTINE PMAX               ALL SYSTEMS                   01/09/22
! PURPOSE :
! GENERAL SUBROUTINE FOR LARGE-SCALE UNCONSTRAINED MINIMAX PROBLEMS
! WITH SPARSE JACOBIAN MATRICES.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  II  NA  NUMBER OF PARTIAL FUNCTIONS.
!  II  MMAX  MAXIMUM DIMENSION OF THE SPARSE TABLEAU.
!  RI  X(NF)  VECTOR OF VARIABLES.
!  IA  IX(NF)  AUXILIARY VECTOR.
!  RO  AF(NA)  VECTOR CONTAINING VALUES OF THE APPROXIMATED
!         FUNCTIONS.
!  RA  AFO(NA)  AUXILIARY VECTOR.
!  RA  AG(MA)  JACOBIAN MATRIX OF THE PARTIALLY SEPARABLE FUNCTION.
!  RA  AGO(NA)  AUXILIARY VECTOR.
!  RA  GA(NF)  GRADIENT OF THE SELECTED PARTIAL FUNCTION.
!  RA  AH(MB)  HESSIAN MATRIX OF THE PARTIALLY SEPARABLE FUNCTION.
!  RA  AZL(NA)  VECTOR OF LOWER LAGRANGE MULTIPLIERS.
!  RA  AZU(NA)  VECTOR OF UPPER LAGRANGE MULTIPLIERS.
!  RO  G(NF)  GRADIENT OF THE OBJECTIVE FUNCTION.
!  RA  H(MMAX)  NONZERO ELEMENTS OF THE APPROXIMATION OF THE SPARSE
!         HESSIAN MATRIX TOGETHER WITH AN ADDITIONAL SPACE USED FOR
!         THE NUMERICAL DIFFERENTIATION.
!  IA  IH(NF+1)  POINTERS OF DIAGONAL ELEMENTS OF THE MATRIX H.
!  IA  JH(MMAX)  INDICES OF NONZERO ELEMENTS OF THE MATRIX H
!         TOGETHER WITH AN ADDITIONAL SPACE USED FOR THE NUMERICAL
!         DIFFERENTIATION.
!  IA  IA(NA)  AUXILIARY VECTOR.
!  II  IAG(NA+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
!  II  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
!  RA  S(NF)  DIRECTION VECTOR.
!  RA  XO(NF)  VECTORS OF VARIABLES DIFFERENCE.
!  RA  GO(NF)  GRADIENTS DIFFERENCE.
!  RA  GS(NF)  AUXILIARY VECTOR.
!  RA  GP(NF)  AUXILIARY VECTOR.
!  IA  COL(NF)  AUXILIARY ARRAY.
!  IA  PSL(NF+1)  POINTER VECTOR OF THE COMPACT FORM OF THE TRIANGULAR
!         FACTOR OF THE HESSIAN APPROXIMATION.
!  IA  PERM(NF)  PERMUTATION VECTOR.
!  IA  INVP(NF)  INVERSE PERMUTATION VECTOR.
!  IA  WN11(NF+1) AUXILIARY VECTOR.
!  IA  WN12(NF+1) AUXILIARY VECTOR.
!  IA  WN13(NF+1) AUXILIARY VECTOR.
!  IA  WN14(NF+1) AUXILIARY VECTOR.
!  RI  XMAX  MAXIMUM STEPSIZE.
!  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 NORM.
!  RI  FMIN  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!  RI  ETA4  COEFFICIENT FOR THE BARRIER PARAMETER DECREASE.
!  RI  ETA5  MINIMUM PERMITTED VALUE OF THE BARRIER PARAMETER.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  II  MIT  MAXIMUM NUMBER OF ITERATIONS.
!  II  MFV  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!  II  MFG  MAXIMUM NUMBER OF GRADIENT EVALUATIONS.
!  II  IEST  ESTIMATION INDICATOR. IEST=0-MINIMUM IS NOT ESTIMATED.
!         IEST=1-MINIMUM IS ESTIMATED BY THE VALUE FMIN.
!  II  MED  METHOD USED. MED=1-PARTITIONED VARIABLE METRIC METHOD.
!         MED=2-DISCRETE NEWTON METHOD.
!  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  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!         VALUES ITERM<=-40 DETECT A LACK OF SPACE.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PALNG3  EXTRACTION OF THE PARTIAL GRADIENT.
!  S   PASSH3  MODIFICATION OF THE HESSIAN MATRIX.
!  S   PF1HS2  NUMERICAL COMPUTATION OF THE HESSIAN MATRIX USING
!         DIFFERENCES OF GRADIENTS.
!  S   PFSEB2  COMPUTATION OF THE SPARSE HESSIAN MATRIX FROM THE
!         PARTITIONED HESSIAN MATRIX IN THE MINIMAX CASE.
!  S   PFSET2  NUMBER OF NONZERO ELEMENTS IN THE PARTITIONED HESSIAN
!         MATRIX.
!  S   PFSET3  PREPARATION OF THE SPARSE NORMAL EQUATION MATRIX
!         STRUCTURE.
!  S   PNFUZ1  DETERMINATION OF THE LAGRANGE MULTIPLIERS.
!  S   PNNEQ1  SOLUTION OF THE BASIC NONLINEAR EQUATION.
!  S   PP0BX1  COMPUTATION OF THE VALUE OF THE BARRIER FUNCTION.
!  S   PP1MX3  COMPUTATION OF THE VALUE AND THE GRADIENT OF THE
!         LAGRANGIAN FUNCTION.
!  S   PS0L02  LINE SEARCH USING ONLY FUNCTION VALUES.
!  S   PUBBM2  VARIABLE METRIC UPDATES OF THE PARTITIONED MATRIX.
!  S   PYFUT8  TEST ON TERMINATION.
!  S   PYPTSH  DETERMINATION OF GROUPS FOR NUMERICAL DIFFERENTIATION.
!  S   PYTCUB  SCALED DIFFERENCE OF THE JACOBIAN MATRICES IN THE
!         MINIMAX CASE.
!  S   PYTRCD  COMPUTATION OF PROJECTED DIFFERENCES FOR THE VARIABLE
!         METRIC UPDATE.
!  S   PYTRCG  COMPUTATION OF THE PROJECTED GRADIENT.
!  S   PYTRCS  COMPUTATION OF THE PROJECTED DIRECTION VECTOR.
!  S   PYTSCH  CORRECTION OF THE HESSIAN MATRIX.
!  S   MXBSMI  INITIATION OF THE PARTITIONED MATRIX.
!  S   MXSPCB  BACK SUBSTITUTION USING THE SPARSE DECOMPOSITION
!         OBTAINED BY MXSPCF.
!  S   MXSPCC  SPARSE MATRIX REORDERING, SYMBOLIC FACTORIZATION, DATA
!         STRUCTURES TRANSFORMATION. INITIATION OF THE DIRECT SPARSE
!         SOLVER.
!  S   MXSPCF  GILL-MURRAY DECOMPOSITION OD A SPARSE SYMMETRIC MATRIX.
!  S   MXSPCT  COPYING A SPARSE SYMMETRIC MATRIX INTO THE PERMUTED
!         FACTORIZED COMPACT SCHEME.
!  S   MXVCOP  COPYING OF A VECTOR.
!  S   MXVDIR  VECTOR AUGMENTED BY THE SCALED VECTOR.
!  RF  MXVDOT  DOT PRODUCT OF TWO VECTORS.
!  S   MXVINE  RESTORATION OF A SPARSE SYMMETRIC MATRIX OBTAINED BY
!         MXVINB
!  S   MXVINS  INITIATION OF THE INTEGER VECTOR.
!  S   MXVNEG  COPYING OF A VECTOR WITH CHANGE OF THE SIGN.
!  S   MXVSBP  INVERSE PERMUTATION OF A VECTOR
!  S   MXVSET  INITIATION OF A VECTOR.
!  S   MXVSFP  PERMUTATION OF A VECTOR.
!
! EXTERNAL SUBROUTINES :
!  SE  FUN  COMPUTATION 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  DFUN  COMPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION.
!         CALLING SEQUENCE: CALL DFUN(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 :
! PRIMAL DISCRETE NEWTON INTERIOR-POINT ALGORITHM FOR LARGE-SCALE
! PARTIALLY SEPARABLE MINIMAX OPTIMIZATION PROBLEMS.
!
      SUBROUTINE PMAX (NF, NA, MMAX, X, IX, AF, AFO, AG, AGO, GA, AH,
     &AZL, AZU, G, H, IH, JH, IA, IAG, JAG, S, XO, GO, GS, GP, COL, PSL,
     & PERM, INVP, WN11, WN12, WN13, WN14, XMAX, TOLX, TOLF, TOLB, TOLG,
     & FMIN, ETA4, ETA5, GMAX, F, MIT, MFV, MFG, IEST, MED, IEXT, IPRNT,
     & ITERM)
      INTEGER NA,NF,MMAX,IX(*),IH(*),JH(*),IA(*),IAG(*),JAG(*),COL(*),
     &PSL(*),PERM(*),INVP(*),WN11(*),WN12(*),WN13(*),WN14(*),MIT,MFV,
     &MFG,IEST,MED,IEXT,IPRNT,ITERM
      DOUBLE PRECISION X(*),AF(*),AFO(*),AG(*),AGO(*),GA(*),AH(*),AZL(*)
     &,AZU(*),G(*),H(*),S(*),XO(*),GO(*),GS(*),GP(*),XMAX,TOLX,TOLF,
     &TOLB,TOLG,FMIN,ETA4,ETA5,GMAX,F
      INTEGER IDECF,ITERD,ITERS,KD,LD,NTESX,NTESF,MTESX,MTESF,MRED,KIT,
     &IREST,KBF,MAXST,IDIR,IOLD,INF,INITD,MEP,MER,MET,MET1,MET3,MET5,
     &IER,ICON,ISYS,KTERS,ITERH,IRES1,IRES2,NRED,I,J,JP,K,L,INITS,MES,M,
     &MA,MB,MM,MH,NNIT,JSTRT,JSTOP,KA,ISNA
      DOUBLE PRECISION R,RO,RP,FF,FO,FP,FA,P,PO,PP,GNORM,SNORM,RMIN,
     &RMAX,FMAX,DMAX,UMAX,ETA0,ETA2,ETA3,ETA6,ETA9,EPS0,EPS1,ALF,ALF1,
     &ALF2,BET,RHO,TOLP,RPF3,PAR,FFO
      DOUBLE PRECISION MXVDOT,PNFUZ1
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      IF (ABS(IPRNT).GT.1) WRITE (6,'(1X,''ENTRY TO PMAX :'')')
!
!     INITIATION OF PROBLEM
!
      KBF=0
      NRES=0
      NDEC=0
      NIN=0
      NIT=0
      NFV=0
      NFG=0
      NFH=0
      ICON=0
      ISYS=0
      NTESX=0
      NTESF=0
      MTESX=2
      MTESF=2
      INITS=1
      INITD=1
      ITERM=0
      ITERD=0
      ITERS=2
      KTERS=5
      IREST=0
      IRES1=999
      IRES2=0
      MRED=20
      IDIR=0
      MEP=1
      MES=1
      ETA0=1.0D-15
      ETA2=1.0D-18
      ETA3=1.0D-6
      IF (ETA4.LE.0.0D0) ETA4=8.5D-1
      ETA6=1.0D0
      ETA9=1.0D120
      EPS0=1.0D-8
      EPS1=1.0D-4
      ALF1=1.0D-10
      ALF2=1.0D10
      RPF3=1.0D0
      RMAX=ETA9
      DMAX=ETA9
      FMAX=1.0D20
      IF (IEXT.EQ.0) THEN
        IF (IEST.LE.0) FMIN=0.0D0
        FMIN=MAX(FMIN,0.0D0)
        IEST=1
      ELSE
        IEST=0
      END IF
      IF (XMAX.LE.0.0D0) XMAX=1.0D16
      IF (TOLX.LE.0.0D0) TOLX=1.0D-16
      IF (TOLF.LE.0.0D0) TOLF=1.0D-14
      IF (TOLB.LE.0.0D0) TOLB=FMIN+1.0D-16
      IF (TOLG.LE.0.0D0) TOLG=1.0D-6
      IF (MIT.LE.0) MIT=10000
      IF (MFV.LE.0) MFV=10000
      IF (MFG.LE.0) MFG=20000
      IF (MED.LE.0) MED=1
      IF (MED.EQ.1) THEN
        MER=2
        MET=1
        MET1=3
        MET3=1
        MET5=1
        KIT=-(IRES1*NF+IRES2)
        CALL PFSET2 (NA, MB, MA, IAG)
        MA=IAG(NA+1)-1
      ELSE
        MED=2
        MER=2
        KIT=0
      END IF
      CALL MXVINP (NF+1, IH)
      CALL MXVINP (NF, JH)
      CALL PFSET3 (NF, NA, M, MMAX, IH, JH, IAG, JAG, ITERM)
      IF (ITERM.NE.0) GO TO 160
      CALL MXVINS (NA, 3, IA)
      IF (IEXT.GT.0) CALL MXVINS (NA, 1, IA)
      IF (IEXT.LT.0) CALL MXVINS (NA, 2, IA)
      IF (MED.EQ.2) CALL PYPTSH (NF, MMAX, IH, JH, COL, S, XO, GO, WN11,
     & WN12, GA, ITERM)
      MH=0
      CALL MXVINE (IH(NF+1)-1, JH)
      CALL MXSPCC (NF, M, MH, MMAX, H, IH, JH, PSL, PERM, INVP, WN11,
     &WN12, WN13, WN14, IER)
      IF (IER.NE.0) THEN
        ITERM=IER
      END IF
!
!     SPARSE NEWTON METHOD
!
      ISNA=2
      KD=MED
      LD=-1
      R=0.0D0
      FO=FMIN
      PAR=0.0D0
      IF (ETA5.LE.0.0D0) THEN
        TOLP=ETA0**(2.0D0/3.0D0)
      ELSE
        TOLP=ETA5
      END IF
      IF (ITERM.NE.0) GO TO 160
!
!     COMPUTATION OF THE VALUE OF THE LAGRANGIAN FUNCTION
!
   10 KD=0
      CALL PP1MX3 (NF, NA, X, GA, AG, IAG, JAG, G, AZL, AZU, FA, AF, FF,
     & KD, LD, NFV, NFG, ISNA, IEXT)
      LD=0
      IF (FF+RPF3.GT.(1.0D0+ETA0)*FF) THEN
        NNIT=20
   20   CALL PNNEQ1 (FF+RPF3, FF+RPF3*DBLE(2*NA), X(NF+1), G(NF+1),
     &   0.0D0, MIN(ETA3,TOLG), NNIT, IER, ICON)
        IF (ICON.GT.0) THEN
          G(NF+1)=PNFUZ1(X(NF+1),NA,RPF3,AF,AZL,AZU,IEXT)
          GO TO 20
        END IF
      ELSE
        X(NF+1)=(1.0D0+ETA0)*FF
        G(NF+1)=PNFUZ1(X(NF+1),NA,RPF3,AF,AZL,AZU,IEXT)
      END IF
      CALL PP0BX1 (NA, X(NF+1), AF, F, FF, PAR, RPF3, MEP, IEXT)
!
!     COMPUTATION OF THE GRADIENT AND THE HESSIAN MATRIX OF THE
!     LAGRANGIAN FUNCTION
!
      KD=1
      CALL PP1MX3 (NF, NA, X, GA, AG, IAG, JAG, G, AZL, AZU, FA, AF, FF,
     & KD, LD, NFV, NFG, ISNA, IEXT)
      LD=1
      IF (MED.EQ.1) GO TO 40
   30 CALL PF1HS2 (NF, MH, MMAX, X, IH, S, H, IH, JH, GO, G, COL, WN11,
     &WN12, GS, FF, ETA0, 0, ITERM, ISYS)
      IF (ISYS.GT.0) THEN
        LD=0
        ISNA=0
        CALL PP1MX3 (NF, NA, X, GA, AG, IAG, JAG, GO, AZL, AZU, FA, AF,
     &   FF, KD, LD, NFV, NFG, ISNA, IEXT)
        GO TO 30
      END IF
      KD=2
      LD=2
      ISNA=2
      IDECF=0
   40 CONTINUE
      IF (NIT.NE.0) GO TO 150
   50 CALL PYTRCG (NF, NF, IX, G, UMAX, GMAX, KBF, IOLD)
      IF (ABS(IPRNT).GT.1) WRITE (6,'(1X,''NIT='',I5,2X,''NFV='',I5,2X,'
     &'NFG='',I5,2X,       ''F='', G16.9,2X,''G='',E10.3)') NIT,NFV,NFG,
     &F,GMAX
      CALL PYFUT8 (NF, FF, FFO, GMAX, DMAX, RPF3, TOLX, TOLF, TOLB,
     &TOLG, TOLP, KD, NIT, KIT, MIT, NFV, MFV, NFG, MFG, NTESX, MTESX,
     &NTESF, MTESF, IRES1, IRES2, IREST, ITERS, ITERM)
      IF (ITERM.NE.0) GO TO 160
   60 IF (IREST.GT.0) THEN
        IF (MED.EQ.1) THEN
          CALL MXBSMI (NA, AH, IAG)
        ELSE
          RHO=GMAX/1.0D1
          DO 80 I=1,NF
            JSTRT=IH(I)
            JSTOP=IH(I+1)-1
            H(JSTRT)=MIN(MAX(RHO*ABS(H(JSTRT)),5.0D-3),5.0D2)
            DO 70 J=JSTRT+1,JSTOP
              H(J)=0.0D0
   70       CONTINUE
   80     CONTINUE
        END IF
        IDECF=0
        IF (KIT.LT.NIT) THEN
          NRES=NRES+1
          KIT=NIT
        ELSE
          ITERM=-10
          IF (ITERS.LT.0) ITERM=ITERS-5
          IF (GMAX.LE.1.0D2*TOLG) ITERM=-ITERM
        END IF
      END IF
      IF (ITERM.NE.0) GO TO 160
      IF (MED.EQ.1) THEN
        CALL MXVSET (IH(NF+1)-1, 0.0D0, H)
        CALL PFSEB4 (NA, H, IH, JH, AH, IAG, JAG, IA, AZL, AZU, MET5)
      ELSE
        CALL PYTSCH (NF, IX, H, IH, JH, KBF)
      END IF
!
!     DIRECTION DETERMINATION
!
      GNORM=SQRT(MXVDOT(NF,G,G))
      CALL MXVSET (NF+1, 0.0D0, GS)
      DO 100 KA=1,NA
        ALF=0.0D0
        BET=0.0D0
        IF (IEXT.LE.0) THEN
          RHO=AZU(KA)**2
          ALF=ALF+RHO
          BET=BET+RHO
        END IF
        IF (IEXT.GE.0) THEN
          RHO=AZL(KA)**2
          ALF=ALF+RHO
          BET=BET-RHO
        END IF
        ALF=ALF/RPF3
        BET=BET/RPF3
        CALL PALNG3 (AG, IAG, JAG, GO, KA)
        CALL PASSH3 (H, IH, JH, IAG, JAG, GO, KA, ALF)
        K=IAG(KA)
        L=IAG(KA+1)-K
        DO 90 J=1,L
          JP=ABS(JAG(K))
          GS(JP)=GS(JP)+BET*AG(K)
          K=K+1
   90   CONTINUE
        GS(NF+1)=GS(NF+1)+ALF
  100 CONTINUE
      IF (IDECF.NE.0.AND.IDECF.NE.1) THEN
        ITERD=-1
        GO TO 110
      END IF
      INITD=MAX(ABS(INITD),1)
      MM=IH(NF+1)-1
      IF (IDECF.NE.1) THEN
        CALL MXSPCT (NF, MM, MH, MMAX, H, JH, PSL, ITERM)
        IF (ITERM.NE.0) THEN
          GO TO 110
        END IF
!
!     GILL-MURRAY DECOMPOSITION
!
        RHO=ETA2
        CALL MXSPCF (NF, H(MM+1), PSL, JH(MM+1), WN11, WN12, GO, INF,
     &   RHO, ALF)
        NDEC=NDEC+1
        IDECF=1
      END IF
!
!     BACK SUBSTITUTIONS
!
      CALL MXVCOP (NF, GS, GP)
      CALL MXVSFP (NF, PERM, GP, GO)
      CALL MXSPCB (NF, H(MM+1), PSL, JH(MM+1), GP, 0)
      CALL MXVSBP (NF, PERM, GP, GO)
      CALL MXVNEG (NF, G, S)
      CALL MXVSFP (NF, PERM, S, GO)
      CALL MXSPCB (NF, H(MM+1), PSL, JH(MM+1), S, 0)
      CALL MXVSBP (NF, PERM, S, GO)
      IF (MXVDOT(NF,GS,GP)-GS(NF+1).EQ.0.0D0) THEN
        S(NF+1)=0.0D0
      ELSE
        S(NF+1)=-(MXVDOT(NF,GS,S)-G(NF+1))/(MXVDOT(NF,GS,GP)-GS(NF+1))
        CALL MXVDIR (NF, S(NF+1), GP, S, S)
      END IF
      SNORM=SQRT(MXVDOT(NF,S,S))
!
!     COMPUTATION OF THE DIRECTIONAL DERIVATIVE
!
      P=MXVDOT(NF,S,G)
  110 CONTINUE
      R=0.0D0
!
!     END OF DIRECTION DETERMINATION
!
      IF (KD.GT.0) P=MXVDOT(NF,G,S)
!
!     TEST ON DESCENT DIRECTION AND PREPARATION OF LINE SEARCH
!
      IF (ITERD.LT.0) THEN
        ITERM=ITERD
      ELSE
!
!     TEST ON DESCENT DIRECTION
!
        IF (SNORM.LE.0.0D0) THEN
          IREST=MAX(IREST,1)
        ELSE IF (P+EPS0*GNORM*SNORM.LE.0.0D0) THEN
          IREST=0
        ELSE
!
!     UNIFORM DESCENT CRITERION
!
          IREST=MAX(IREST,1)
        END IF
        IF (IREST.EQ.0) THEN
!
!     PREPARATION OF LINE SEARCH
!
          NRED=0
          RMIN=ALF1*GNORM/SNORM
          RMAX=MIN(ALF2*GNORM/SNORM,XMAX/SNORM)
        END IF
      END IF
      IF (ITERM.NE.0) GO TO 160
      IF (IREST.NE.0) GO TO 60
      IF (NIT.EQ.1) KIT=NIT
      CALL PYTRCS (NF, X, IX, XO, X, X, G, GO, S, RO, FP, FO, F, PO, P,
     &RMAX, ETA9, KBF)
      FFO=FF
      XO(NF+1)=X(NF+1)
      GO(NF+1)=G(NF+1)
      CALL MXVCOP (NA, AF, AFO)
      IF (MED.EQ.1) CALL MXVCOP (MA, AG, AGO)
  120 CALL PS0L02 (R, RO, RP, F, FO, FP, PO, PP, FMIN, FMAX, RMIN, RMAX,
     & EPS1, KD, LD, NIT, KIT, NRED, MRED, MAXST, IEST, INITS, ITERS,
     &KTERS, MES, ISYS)
      IF (ISYS.EQ.0) GO TO 140
      CALL MXVDIR (NF, R, S, XO, X)
      CALL PP1MX3 (NF, NA, X, GA, AG, IAG, JAG, G, AZL, AZU, FA, AF, FF,
     & KD, LD, NFV, NFG, ISNA, IEXT)
      LD=KD
      IF (FF+RPF3.GT.(1.0D0+ETA0)*FF) THEN
        NNIT=20
  130   CALL PNNEQ1 (FF+RPF3, FF+RPF3*DBLE(2*NA), X(NF+1), G(NF+1),
     &   0.0D0, MIN(ETA3,TOLG), NNIT, IER, ICON)
        IF (ICON.GT.0) THEN
          G(NF+1)=PNFUZ1(X(NF+1),NA,RPF3,AF,AZL,AZU,IEXT)
          GO TO 130
        END IF
      ELSE
        X(NF+1)=(1.0D0+ETA0)*FF
        G(NF+1)=PNFUZ1(X(NF+1),NA,RPF3,AF,AZL,AZU,IEXT)
      END IF
      CALL PP0BX1 (NA, X(NF+1), AF, F, FF, PAR, RPF3, MEP, IEXT)
      GO TO 120
  140 CONTINUE
      KD=MED
      IF (ITERS.LE.0) THEN
        R=0.0D0
        F=FO
        P=PO
        CALL MXVCOP (NF, XO, X)
        FF=FFO
        X(NF+1)=XO(NF+1)
        G(NF+1)=GO(NF+1)
        CALL MXVCOP (NA, AFO, AF)
        IF (MED.EQ.1) CALL MXVCOP (MA, AGO, AG)
        IF (IDIR.EQ.0) IREST=MAX(IREST,1)
        LD=KD
        GO TO 60
      END IF
      IF (MER.EQ.1) THEN
        RPF3=MIN(ETA4*RPF3,GNORM**2)
      ELSE IF (MER.EQ.2) THEN
        RPF3=MIN(MAX(ETA4*RPF3,RPF3/(1.0D2*RPF3+1.0D0)),MAX(GNORM**2,
     &   1.0D-2**NIT))
      ELSE IF (MER.EQ.3) THEN
        IF (GNORM.GE.ETA6) THEN
        ELSE
          RPF3=MIN(MAX(ETA4*RPF3,RPF3/(1.0D2*RPF3+1.0D0)),MAX(GNORM**2,
     &     1.0D-2**NIT))
        END IF
      ELSE IF (MER.EQ.4) THEN
        IF (GNORM.GE.ETA6) THEN
        ELSE
          IF (RPF3.GE.1.0D1*GNORM**2) RPF3=GNORM**2
        END IF
      END IF
      RPF3=MAX(RPF3,TOLP)
      GO TO 10
  150 CONTINUE
      CALL PYTRCD (NF, X, IX, XO, G, GO, R, F, FO, P, PO, DMAX, KBF, KD,
     & LD, ITERS)
      IF (MED.EQ.1) THEN
        CALL PYTCUB (NA, MA, AG, AGO, IAG, IA, AZL, AZU, ITERS, MET5)
        IDECF=0
        CALL PUBBM2 (NA, AH, IAG, JAG, S, XO, AGO, ETA0, ETA9, NIT, KIT,
     &    ITERH, MET, MET1, MET3)
        IF (ITERH.NE.0) IREST=MAX(IREST,1)
      END IF
      GO TO 50
  160 CONTINUE
      F=FF
      IF (IPRNT.GT.1.OR.IPRNT.LT.0) WRITE (6,'(1X,''EXIT FROM PMAX :'')'
     &)
      IF (IPRNT.NE.0) WRITE (6,'(1X,''NIT='',I5,2X,''NFV='',I5,2X,''NFG=
     &'',I5,2X,       ''F='', G16.9,2X,''G='',E10.3,2X,''ITERM='',I3)')
     &NIT,NFV,NFG,F,GMAX,ITERM
      IF (IPRNT.LT.0) WRITE (6,'(1X,''X='',5(G14.7,1X):/(3X,5(G14.7,1X))
     &)') (X(I),I=1,NF)
      END
! SUBROUTINE PNECU              ALL SYSTEMS                   97/01/22
! PURPOSE :
! EASY TO USE SUBROUTINE FOR UNCONSTRAINED MINIMIZATION OF
! FUNCTIONS WITH LARGE-SCALE SPARSE HESSIAN MATRICES
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  IU  MH  NUMBER OF NONZERO ELEMENTS IN THE UPPER PART OF THE HESSIAN
!         MATRIX.
!  RI  X(NF)  VECTOR OF VARIABLES.
!  II  IH(NF+1)  POINTERS OF DIAGONAL ELEMENTS OF THE MATRIX H.
!  IU  JH(MH)  INDICES OF NONZERO ELEMENTS OF THE MATRIX H
!         TOGETHER WITH AN ADDITIONAL SPACE USED FOR THE NUMERICAL
!         DIFFERENTIATION.
!  II  IPAR(7)  INTEGER PAREMETERS:
!      IPAR(1)  MAXIMUM NUMBER OF ITERATIONS.
!      IPAR(2)  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!      IPAR(3)  MAXIMUM NUMBER OF GRADIENT EVALUATIONS.
!      IPAR(4)  ESTIMATION INDICATOR. IPAR(4)=0-MINIMUM IS NOT
!         ESTIMATED. IPAR(4)=1-MINIMUM IS ESTIMATED BY THE VALUE
!         RPAR(6).
!      IPAR(5)  METHOD FOR COMPUTING A TRUST REGION STEP. IPAR(5)=1-THE
!         STEIHAUG-TOINT METHOD. IPAR(5)=2-THE SHIFTED STEIHAUG-TOINT
!         METHOD WITH FIVE LANCZOS STEPS. IPAR(5)>2-THE SHIFTED
!         STEIHAUG-TOINT METHOD WITH IPAR(5) LANCZOS STEPS.
!      IPAR(6)  TYPE OF PRECONDITIONING. IPAR(6)=1-PRECONDITIONING IS
!         NOT USED. IPAR(6)=2-PRECONDITIONING BY THE INCOMPLETE
!         GILL-MURRAY DECOMPOSITION. IPAR(6)=3-PRECONDITIONING BY THE
!         INCOMPLETE GILL-MURRAY DECOMPOSITION WITH A PRELIMINARY
!         SOLUTION OF THE PRECONDITIONED SYSTEM WHICH IS USED IF IT
!         SATISFIES THE TERMINATION CRITERION.
!      IPAR(7)  NUMBER DEFINING THE SPACE FOR FILL-IN (THE SIZE OF THIS
!         SPACE IS IFIL TIMES THE STANDARD SIZE). THE DEFAULT VALUE IS
!         IFIL=1. THE DEFAULT VALUE HAS TO BE INCREASED IF ITERM IS
!         LESS OR EQUAL TO -40.
!  RI  RPAR(9)  REAL PARAMETERS:
!      RPAR(1)  MAXIMUM STEPSIZE.
!      RPAR(2)  TOLERANCE FOR THE CHANGE OF VARIABLES.
!      RPAR(3)  TOLERANCE FOR THE CHANGE OF FUNCTION VALUES.
!      RPAR(4)  TOLERANCE FOR THE FUNCTION FALUE.
!      RPAR(5)  TOLERANCE FOR THE GRADIENT NORM.
!      RPAR(6)  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!      RPAR(7)  INITIAL TRUST-REGION RADIUS.
!      RPAR(8)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PNEC.
!      RPAR(9)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PNEC.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  II  ISPAS  INPUT SPARSE STRUCTURE. ISPAS=1-STANDARD COORDINATE
!         FORM. ISPAS=2-SPARSE STRUCTURE COMPRESSED BY ROWS.
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!         VALUES ITERM<=-40 DETECT A LACK OF SPACE. IN THIS CASE,
!         PARAMETER IPAR(7) HAS TO BE INCREASED.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PNEC  DISCRETE NEWTON METHOD WITH ITERATIVE SOLUTION OF THE
!         TRUST-REGION SUBPROBLEM.
!  S   PFSED3  COMPRESSED SPARSE STRUCTURE OF THE HESSIAN MATRIX IS
!         COMPUTED FROM THE COORDINATE FORM.
!  S   MXVICP COPYING OF AN INTEGER VECTOR.
!
! EXTERNAL SUBROUTINES :
!  SE  OBJ  COMPUTATION OF THE VALUE OF THE OBJECTIVE FUNCTION.
!         CALLING SEQUENCE: CALL OBJ(NF,X,FF) WHERE NF IS THE NUMBER
!         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND FF IS
!         THE VALUE OF THE OBJECTIVE FUNCTION.
!  SE  DOBJ  COMPUTATION OF THE GRADIENT OF THE OBJECTIVE FUNCTION.
!         CALLING SEQUENCE: CALL DOBJ(NF,X,GF) WHERE NF IS THE NUMBER
!         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND GF(NF)
!         IS THE GRADIENT OF THE OBJECTIVE FUNCTION.
!
      SUBROUTINE PNECU (NF, MH, X, IH, JH, IPAR, RPAR, F, GMAX, ISPAS,
     &IPRNT, ITERM)
      INTEGER NF,MH,IH(*),JH(*),IPAR(7),ISPAS,IPRNT,ITERM
      DOUBLE PRECISION X(*),RPAR(9),F,GMAX
      INTEGER NB,LGF,LHF,LS,LXO,LGO,LXS,LGS,LCOL,LWN11,LWN12,LIW,LJH,
     &IFIL,IER
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      INTEGER IA(:)
      DOUBLE PRECISION RA(:)
      ALLOCATABLE IA,RA
      IFIL=IPAR(7)
      IF (IFIL.LE.0) IFIL=1
      IF (ISPAS.LE.1) THEN
        CALL PFSED3 (NF, MH, IH, JH, IER)
        IF (IER.NE.0) THEN
          WRITE (6,'(''INPUT ERROR : IER = '',I3)') IER
          STOP
        END IF
      ELSE
        MH=IH(NF+1)-1
      END IF
      ALLOCATE(IA(4*NF+3+(IFIL+2)*MH),RA(6*NF+1+(IFIL+2)*MH))
      NB=0
!
!     POINTERS FOR AUXILIARY ARRAYS
!
      LGF=1
      LS=LGF+NF
      LXO=LS+NF
      LGO=LXO+NF
      LXS=LGO+NF+1
      LGS=LXS+NF
      LHF=LGS+NF
      LCOL=1
      LWN11=LCOL+NF
      LWN12=LWN11+NF+1
      LIW=LWN12+NF+1
      LJH=LIW+NF+1
      CALL MXVICP (IH(NF+1)-1, JH, IA(LJH))
      CALL PNEC (NF, NB, (IFIL+2)*MH, X, IA, RA, RA, RA(LGF), RA(LHF),
     &IH, IA(LJH), RA(LS), RA(LXO), RA(LGO), RA(LXS), RA(LGS), IA(LCOL),
     & IA(LWN11), IA(LWN12), IA(LIW), 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), IPRNT, ITERM)
      DEALLOCATE(IA,RA)
      RETURN
      END
! SUBROUTINE PNECS              ALL SYSTEMS                   97/01/22
! PURPOSE :
! EASY TO USE SUBROUTINE FOR BOX CONSTRAINED MINIMIZATION OF
! LARGE-SCALE FUNCTIONS WITH SPARSE HESSIAN MATRICES
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  IU  MH  NUMBER OF NONZERO ELEMENTS IN THE UPPER PART OF THE HESSIAN
!         MATRIX.
!  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-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.
!  II  IH(NF+1)  POINTERS OF DIAGONAL ELEMENTS OF THE MATRIX H.
!  IU  JH(MH)  INDICES OF NONZERO ELEMENTS OF THE MATRIX H
!         TOGETHER WITH AN ADDITIONAL SPACE USED FOR THE NUMERICAL
!         DIFFERENTIATION.
!  II  IPAR(7)  INTEGER PAREMETERS:
!      IPAR(1)  MAXIMUM NUMBER OF ITERATIONS.
!      IPAR(2)  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!      IPAR(3)  MAXIMUM NUMBER OF GRADIENT EVALUATIONS.
!      IPAR(4)  ESTIMATION INDICATOR. IPAR(4)=0-MINIMUM IS NOT
!         ESTIMATED. IPAR(4)=1-MINIMUM IS ESTIMATED BY THE VALUE
!         RPAR(6).
!      IPAR(5)  METHOD FOR COMPUTING A TRUST REGION STEP. IPAR(5)=1-THE
!         STEIHAUG-TOINT METHOD. IPAR(5)=2-THE SHIFTED STEIHAUG-TOINT
!         METHOD WITH FIVE LANCZOS STEPS. IPAR(5)>2-THE SHIFTED
!         STEIHAUG-TOINT METHOD WITH IPAR(5) LANCZOS STEPS.
!      IPAR(6)  TYPE OF PRECONDITIONING. IPAR(6)=1-PRECONDITIONING IS
!         NOT USED. IPAR(6)=2-PRECONDITIONING BY THE INCOMPLETE
!         GILL-MURRAY DECOMPOSITION. IPAR(6)=3-PRECONDITIONING BY THE
!         INCOMPLETE GILL-MURRAY DECOMPOSITION WITH A PRELIMINARY
!         SOLUTION OF THE PRECONDITIONED SYSTEM WHICH IS USED IF IT
!         SATISFIES THE TERMINATION CRITERION.
!      IPAR(7)  NUMBER DEFINING THE SPACE FOR FILL-IN (THE SIZE OF THIS
!         SPACE IS IFIL TIMES THE STANDARD SIZE). THE DEFAULT VALUE IS
!         IFIL=1. THE DEFAULT VALUE HAS TO BE INCREASED IF ITERM IS
!         LESS OR EQUAL TO -40.
!  RI  RPAR(9)  REAL PARAMETERS:
!      RPAR(1)  MAXIMUM STEPSIZE.
!      RPAR(2)  TOLERANCE FOR THE CHANGE OF VARIABLES.
!      RPAR(3)  TOLERANCE FOR THE CHANGE OF FUNCTION VALUES.
!      RPAR(4)  TOLERANCE FOR THE FUNCTION FALUE.
!      RPAR(5)  TOLERANCE FOR THE GRADIENT NORM.
!      RPAR(6)  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!      RPAR(7)  INITIAL TRUST-REGION RADIUS.
!      RPAR(8)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PNEC.
!      RPAR(9)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PNEC.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  II  ISPAS  INPUT SPARSE STRUCTURE. ISPAS=1-STANDARD COORDINATE
!         FORM. ISPAS=2-SPARSE STRUCTURE COMPRESSED BY ROWS.
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!         VALUES ITERM<=-40 DETECT A LACK OF SPACE. IN THIS CASE,
!         PARAMETER IPAR(7) HAS TO BE INCREASED.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PNEC  DISCRETE NEWTON METHOD WITH ITERATIVE SOLUTION OF THE
!         TRUST-REGION SUBPROBLEM.
!  S   PFSED3  COMPRESSED SPARSE STRUCTURE OF THE HESSIAN MATRIX IS
!         COMPUTED FROM THE COORDINATE FORM.
!  S   MXVICP COPYING OF AN INTEGER VECTOR.
!
! EXTERNAL SUBROUTINES :
!  SE  OBJ  COMPUTATION OF THE VALUE OF THE OBJECTIVE FUNCTION.
!         CALLING SEQUENCE: CALL OBJ(NF,X,FF) WHERE NF IS THE NUMBER
!         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND FF IS
!         THE VALUE OF THE OBJECTIVE FUNCTION.
!  SE  DOBJ  COMPUTATION OF THE GRADIENT OF THE OBJECTIVE FUNCTION.
!         CALLING SEQUENCE: CALL DOBJ(NF,X,GF) WHERE NF IS THE NUMBER
!         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND GF(NF)
!         IS THE GRADIENT OF THE OBJECTIVE FUNCTION.
!
      SUBROUTINE PNECS (NF, MH, X, IX, XL, XU, IH, JH, IPAR, RPAR, F,
     &GMAX, ISPAS, IPRNT, ITERM)
      INTEGER NF,MH,IX(*),IH(*),JH(*),IPAR(7),ISPAS,IPRNT,ITERM
      DOUBLE PRECISION X(*),XL(*),XU(*),RPAR(8),F,GMAX
      INTEGER NB,LGF,LHF,LS,LXO,LGO,LXS,LGS,LCOL,LWN11,LWN12,LIW,LJH,
     &IFIL,IER
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      INTEGER IA(:)
      DOUBLE PRECISION RA(:)
      ALLOCATABLE IA,RA
      IFIL=IPAR(7)
      IF (IFIL.LE.0) IFIL=1
      IF (ISPAS.LE.1) THEN
        CALL PFSED3 (NF, MH, IH, JH, IER)
        IF (IER.NE.0) THEN
          WRITE (6,'(''INPUT ERROR : IER = '',I3)') IER
          STOP
        END IF
      ELSE
        MH=IH(NF+1)-1
      END IF
      ALLOCATE(IA(4*NF+3+(IFIL+2)*MH),RA(6*NF+1+(IFIL+2)*MH))
      NB=1
!
!     POINTERS FOR AUXILIARY ARRAYS
!
      LGF=1
      LS=LGF+NF
      LXO=LS+NF
      LGO=LXO+NF
      LXS=LGO+NF+1
      LGS=LXS+NF
      LHF=LGS+NF
      LCOL=1
      LWN11=LCOL+NF
      LWN12=LWN11+NF+1
      LIW=LWN12+NF+1
      LJH=LIW+NF+1
      CALL MXVICP (IH(NF+1)-1, JH, IA(LJH))
      CALL PNEC (NF, NB, (IFIL+2)*MH, X, IX, XL, XU, RA(LGF), RA(LHF),
     &IH, IA(LJH), RA(LS), RA(LXO), RA(LGO), RA(LXS), RA(LGS), IA(LCOL),
     & IA(LWN11), IA(LWN12), IA(LIW), 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), IPRNT, ITERM)
      DEALLOCATE(IA,RA)
      RETURN
      END
! SUBROUTINE PNEC               ALL SYSTEMS                   01/09/22
! PURPOSE :
! GENERAL SUBROUTINE FOR LARGE-SCALE BOX CONSTRAINED MINIMIZATION OF
! FUNCTIONS WITH SPARSE HESSIAN MATRICES BASED ON THE DISCRETE NEWTON
! METHOD WITH ITERATIVE SOLUTION OF THE TRUST-REGION SUBPROBLEM.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  II  NB  CHOICE OF SIMPLE BOUNDS. NB=0-SIMPLE BOUNDS SUPPRESSED.
!         NB>0-SIMPLE BOUNDS ACCEPTED.
!  II  MMAX  MAXIMUM DIMENSION OF THE SPARSE TABLEAU.
!  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.
!  RU  GF(NF)  GRADIENT OF THE OBJECTIVE FUNCTION.
!  RA  HF(MMAX)  NONZERO ELEMENTS OF THE SPARSE HESSIAN MATRIX
!         TOGETHER WITH AN ADDITIONAL SPACE USED FOR THE NUMERICAL
!         DIFFERENTIATION.
!  II  IH(NF+1)  POINTERS OF DIAGONAL ELEMENTS OF THE MATRIX H.
!  IU  JH(MMAX)  INDICES OF NONZERO ELEMENTS OF THE MATRIX H
!         TOGETHER WITH AN ADDITIONAL SPACE USED FOR THE NUMERICAL
!         DIFFERENTIATION.
!  RO  S(NF)  DIRECTION VECTOR.
!  RU  XO(NF)  VECTORS OF VARIABLES DIFFERENCE.
!  RI  GO(NF)  GRADIENTS DIFFERENCE.
!  RA  XS(NF)  AUXILIARY VECTOR.
!  RA  GS(NF)  AUXILIARY VECTOR.
!  IA  COL(NF)  AUXILIARY ARRAY.
!  IA  WN11(NF+1) AUXILIARY VECTOR.
!  IA  WN12(NF+1) AUXILIARY VECTOR.
!  IA  IW(NF+1)  AUXILIARY VECTOR.
!  RI  XMAX  MAXIMUM STEPSIZE.
!  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 NORM.
!  RI  FMIN  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!  RI  XDEL  TRUST REGION STEPSIZE.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  II  MIT  MAXIMUM NUMBER OF ITERATIONS.
!  II  MFV  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!  II  MFG  MAXIMUM NUMBER OF GRADIENT EVALUATIONS.
!  II  IEST  ESTIMATION INDICATOR. IEST=0-MINIMUM IS NOT ESTIMATED.
!         IEST=1-MINIMUM IS ESTIMATED BY THE VALUE RPAR(8)
!  II  MOS1  METHOD FOR COMPUTING A TRUST REGION STEP. MOS1=1-THE
!         STEIHAUG-TOINT METHOD. MOS1=2-THE SHIFTED STEIHAUG-TOINT
!         METHOD WITH FIVE LANCZOS STEPS. MOS1>2-THE SHIFTED
!         STEIHAUG-TOINT METHOD WITH MOS1 LANCZOS STEPS.
!  II  MOS2  TYPE OF PRECONDITIONING. MOS2=1-PRECONDITIONING IS NOT
!         USED. MOS2=2-PRECONDITIONING BY THE INCOMPLETE GILL-MURRAY
!         DECOMPOSITION. MOS2=3-PRECONDITIONING BY THE INCOMPLETE
!         GILL-MURRAY DECOMPOSITION WITH A PRELIMINARY SOLUTION OF
!         THE PRECONDITIONED SYSTEM WHICH IS USED IF IT SATISFIES
!         THE TERMINATION CRITERION.
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!         VALUES ITERM<=-40 DETECT A LACK OF SPACE.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PCBS04  ELIMINATION OF BOX CONSTRAINT VIOLATIONS.
!  S   PDSGM4  DIRECTION DETERMINATION USING THE STEIHAUG-TOINT AND
!         SHIFTED STEIHAUG-TOINT TRUST-REGION METHOD.
!  S   PF1HS2  NUMERICAL COMPUTATION OF THE HESSIAN MATRIX USING
!         DIFFERENCES OF GRADIENTS.
!  S   PS0G01  STEPSIZE SELECTION USING TRUST REGION.
!  S   PYADC0  ADDITION OF A BOX CONSTRAINT.
!  S   PYFUT1  TEST ON TERMINATION.
!  S   PYPTSH  DETERMINATION OF GROUPS FOR NUMERICAL DIFFERENTIATION.
!  S   PYRMC0  DELETION OF A BOX CONSTRAINT.
!  S   PYTRCD  COMPUTATION OF PROJECTED DIFFERENCES FOR THE VARIABLE
!         METRIC UPDATE.
!  S   PYTRCG  COMPUTATION OF THE PROJECTED GRADIENT.
!  S   PYTRCS  COMPUTATION OF THE PROJECTED DIRECTION VECTOR.
!  S   PYTSCH  CORRECTION OF THE HESSIAN MATRIX.
!  S   MXSSMI  SPARSE SYMMETRIC MATRIX IS REPLACED BY THE UNIT MATRIX.
!  S   MXUDIR  VECTOR AUGMENTED BY THE SCALED VECTOR.
!  S   MXVCOP  COPYING OF A VECTOR.
!  S   MXVINB  PROJECTION OF A SPARSE SYMMETRIC MATRIX TO SATISFY BOX
!         CONSTRAINTS.
!  S   MXVINE  RESTORATION OF A SPARSE SYMMETRIC MATRIX OBTAINED BY
!         MXVINB
!
! EXTERNAL SUBROUTINES :
!  SE  OBJ  COMPUTATION OF THE VALUE OF THE OBJECTIVE FUNCTION.
!         CALLING SEQUENCE: CALL OBJ(NF,X,FF) WHERE NF IS THE NUMBER
!         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND FF IS
!         THE VALUE OF THE OBJECTIVE FUNCTION.
!  SE  DOBJ  COMPUTATION OF THE GRADIENT OF THE OBJECTIVE FUNCTION.
!         CALLING SEQUENCE: CALL DOBJ(NF,X,GF) WHERE NF IS THE NUMBER
!         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND GF(NF)
!         IS THE GRADIENT OF THE OBJECTIVE FUNCTION.
!
! METHOD :
! DISCRETE NEWTON METHOD WITH TRUST-REGION STRATEGIES BASED ON
! CONJUGATE GRADIENT ITERATIONS.
!
      SUBROUTINE PNEC (NF, NB, MMAX, X, IX, XL, XU, GF, HF, IH, JH, S,
     &XO, GO, XS, GS, COL, WN11, WN12, IW, XMAX, TOLX, TOLF, TOLB, TOLG,
     & FMIN, XDEL, GMAX, F, MIT, MFV, MFG, IEST, MOS1, MOS2, IPRNT,
     &ITERM)
      INTEGER NF,NB,MMAX,IX(*),IH(*),JH(*),COL(*),WN11(*),WN12(*),IW(*),
     &MIT,MFV,MFG,IEST,MOS2,MOS1,IPRNT,ITERM
      DOUBLE PRECISION X(*),XL(*),XU(*),GF(*),HF(*),S(*),XO(*),GO(*),
     &XS(*),GS(*),XMAX,TOLX,TOLF,TOLB,TOLG,FMIN,XDEL,GMAX,F
      INTEGER IDECF,ITERD,ITERS,ITERH,KD,LD,NTESX,NTESF,MTESX,MTESF,
     &MRED,KIT,IREST,KBF,MES1,MES2,MES3,MOS3,MAXST,IDIR,ISYS,ITES,KTERS,
     &IRES1,IRES2,NRED,INEW,IOLD,I,M,MH,N
      DOUBLE PRECISION R,RO,FO,FP,P,PO,PP,GNORM,GNORMO,SNORM,RMAX,FMAX,
     &DMAX,UMAX,ETA0,ETA2,ETA9,EPS4,EPS5,EPS8,EPS9,BET1,BET2,GAM1,GAM2,
     &DEL1,XDELO
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      IF (ABS(IPRNT).GT.1) WRITE (6,'(1X,''ENTRY TO PNEC :'')')
!
!     INITIATION
!
      KBF=0
      IF (NB.GT.0) KBF=2
      NRES=0
      NDEC=0
      NIN=0
      NIT=0
      NFV=0
      NFG=0
      NFH=0
      IDIR=0
      ISYS=0
      ITES=1
      MTESX=2
      MTESF=2
      ITERM=0
      ITERD=0
      ITERS=2
      ITERH=0
      KTERS=0
      IREST=0
      IRES1=999
      IRES2=0
      IDECF=1
      MRED=10
      MES1=3
      MES2=2
      MES3=1
      MOS3=1
      ETA0=1.0D-15
      ETA2=1.0D-8
      ETA9=1.0D120
      EPS4=0.10D0
      EPS5=0.90D0
      EPS8=1.00D0
      EPS9=1.00D-8
      BET1=0.05D0
      BET2=0.75D0
      GAM1=2.0D0
      GAM2=1.0D6
      DEL1=0.95D0
      RMAX=ETA9
      DMAX=ETA9
      FMAX=1.0D60
      IF (IEST.LE.0) FMIN=-1.0D60
      IF (IEST.GT.0) IEST=1
      IF (XMAX.LE.0.0D0) XMAX=1.0D16
      XDEL=MIN(XDEL,XMAX)
      IF (TOLX.LE.0.0D0) TOLX=1.0D-16
      IF (TOLF.LE.0.0D0) TOLF=1.0D-14
      IF (TOLG.LE.0.0D0) TOLG=1.0D-6
      IF (TOLB.LE.0.0D0) TOLB=FMIN+1.0D-16
      IF (MIT.LE.0) MIT=5000
      IF (MFV.LE.0) MFV=5000
      IF (MFG.LE.0) MFG=10000
      IF (MOS1.LE.0) MOS1=2
      IF (MOS1.EQ.2) MOS1=5
      IF (MOS2.LE.0) MOS2=2
      KD=2
      LD=-1
      KIT=0
      FO=FMIN
!
!     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
   10   CONTINUE
      END IF
      M=IH(NF+1)-1
      IF (KBF.GT.0) THEN
        CALL PCBS04 (NF, X, IX, XL, XU, EPS9, KBF)
        CALL PYADC0 (NF, N, X, IX, XL, XU, INEW)
        CALL MXVINE (IH(NF+1)-1, JH)
      END IF
      CALL PYPTSH (NF, MMAX, IH, JH, COL, S, XO, GO, WN11, WN12, GF,
     &ITERM)
      MH=0
      CALL MXVINS (M, 0, JH(M+1))
      IF (ITERM.LT.0) GO TO 110
      CALL OBJ (NF, X, F)
      NFV=NFV+1
      CALL DOBJ (NF, X, GF)
      NFG=NFG+1
   20 CALL PF1HS2 (NF, MH, MMAX, X, IX, S, HF, IH, JH, GO, GF, COL,
     &WN11, WN12, XS, F, ETA0, KBF, ITERM, ISYS)
      IF (ISYS.EQ.0) GO TO 30
      CALL DOBJ (NF, X, GO)
      NFG=NFG+1
      GO TO 20
   30 CONTINUE
!
!     START OF THE ITERATION WITH TESTS FOR TERMINATION.
!
   40 CALL PYTRCG (NF, NF, IX, GF, UMAX, GMAX, KBF, IOLD)
      IF (ABS(IPRNT).GT.1) WRITE (6,'(1X,''NIT='',I5,2X,''NFV='',I5,2X,'
     &'NFG='',I5,2X,       ''F='', G16.9,2X,''G='',E10.3)') NIT,NFV,NFG,
     &F,GMAX
      CALL PYFUT1 (NF, F, FO, UMAX, GMAX, DMAX, TOLX, TOLF, TOLB, TOLG,
     &KD, NIT, KIT, MIT, NFV, MFV, NFG, MFG, NTESX, MTESX, NTESF, MTESF,
     & ITES, IRES1, IRES2, IREST, ITERS, ITERM)
      IF (ITERM.NE.0) GO TO 110
      IF (KBF.GT.0) CALL PYRMC0 (NF, N, IX, GF, EPS8, UMAX, GMAX, RMAX,
     &IOLD, IREST)
   50 IF (IREST.GT.0) THEN
        CALL MXSSMI (NF, HF, IH)
        IDECF=0
        LD=MIN(LD,1)
        IF (KIT.LT.NIT) THEN
          NRES=NRES+1
          KIT=NIT
        ELSE
          ITERM=-10
          IF (ITERS.LT.0) ITERM=ITERS-5
          IF (GMAX.LE.1.0D2*TOLG) ITERM=-ITERM
        END IF
      END IF
      IF (ITERM.NE.0) GO TO 110
      IF (KBF.GT.0) THEN
        CALL MXVINB (M, IX, JH)
        CALL PYTSCH (NF, IX, HF, IH, JH, KBF)
      END IF
!
!     DIRECTION DETERMINATION
!
      CALL PDSGM4 (NF, MMAX, IX, GF, HF, IH, JH, S, XO, GO, XS, GS, IW,
     &XMAX, XDEL, GNORM, GNORMO, SNORM, FMIN, F, P, PP, ETA0, ETA2,
     &DEL1, KD, KBF, MOS1, MOS2, MOS3, IEST, IDECF, NDEC, NIT, NIN,
     &ITERD, ITERM)
!
!     TEST ON LOCALLY CONSTRAINED STEP AND PREPARATION OF STEPSIZE
!     SELECTION
!
      IF (ITERD.LT.0) THEN
        ITERM=ITERD
      ELSE
        IF (SNORM.LE.0.0D0) THEN
          IREST=MAX(IREST,1)
        ELSE
          IREST=0
        END IF
        IF (IREST.EQ.0) THEN
          RMAX=XMAX/SNORM
        END IF
      END IF
      IF (ITERM.NE.0) GO TO 110
      IF (IREST.NE.0) GO TO 50
      IF (NIT.EQ.1) KIT=NIT
      CALL PYTRCS (NF, X, IX, XO, XL, XU, GF, GO, S, RO, FP, FO, F, PO,
     &P, RMAX, ETA9, KBF)
      IF (RMAX.EQ.0.0D0) GO TO 100
   60 CALL PS0G01 (R, F, FO, PO, PP, XDEL, XDELO, XMAX, RMAX, SNORM,
     &BET1, BET2, GAM1, GAM2, EPS4, EPS5, KD, LD, IDIR, ITERS, ITERD,
     &MAXST, NRED, MRED, KTERS, MES1, MES2, MES3, ISYS)
      IF (ISYS.EQ.0) GO TO 70
      CALL MXUDIR (NF, R, S, XO, X, IX, KBF)
      CALL PCBS04 (NF, X, IX, XL, XU, EPS9, KBF)
      CALL OBJ (NF, X, F)
      NFV=NFV+1
      GO TO 60
   70 CONTINUE
      KD=2
      IF (ITERS.LE.0) THEN
        R=0.0D0
        F=FO
        P=PO
        CALL MXVCOP (NF, XO, X)
        IF (ITERS.LT.0) THEN
          ITERM=-6
          IF (GMAX.LE.1.0D2*TOLG) ITERM=-ITERM
          GO TO 110
        END IF
        IF (IDIR.EQ.0) IREST=MAX(IREST,1)
        LD=KD
        GO TO 50
      END IF
      IF (KD.GT.LD) THEN
        CALL DOBJ (NF, X, GF)
        NFG=NFG+1
   80   CALL PF1HS2 (NF, MH, MMAX, X, IX, S, HF, IH, JH, GO, GF, COL,
     &   WN11, WN12, XS, F, ETA0, KBF, ITERM, ISYS)
        IF (ISYS.EQ.0) GO TO 90
        CALL DOBJ (NF, X, GO)
        NFG=NFG+1
        GO TO 80
   90   CONTINUE
      END IF
      CALL PYTRCD (NF, X, IX, XO, GF, GO, R, F, FO, P, PO, DMAX, KBF,
     &KD, LD, ITERS)
  100 CONTINUE
      IF (KBF.GT.0) CALL PYADC0 (NF, N, X, IX, XL, XU, INEW)
      GO TO 40
  110 CONTINUE
      IF (IPRNT.GT.1.OR.IPRNT.LT.0) WRITE (6,'(1X,''EXIT FROM PNEC :'')'
     &)
      IF (IPRNT.NE.0) WRITE (6,'(1X,''NIT='',I5,2X,''NFV='',I5,2X,''NFG=
     &'',I5,2X,       ''F='', G16.9,2X,''G='',E10.3,2X,''ITERM='',I3)')
     &NIT,NFV,NFG,F,GMAX,ITERM
      IF (IPRNT.LT.0) WRITE (6,'(1X,''X='',5(G14.7,1X):/(3X,5(G14.7,1X))
     &)') (X(I),I=1,NF)
      RETURN
      END
! SUBROUTINE PNEDU              ALL SYSTEMS                   97/01/22
! PURPOSE :
! EASY TO USE SUBROUTINE FOR UNCONSTRAINED MINIMIZATION OF
! FUNCTIONS WITH LARGE-SCALE SPARSE HESSIAN MATRICES
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  IU  MH  NUMBER OF NONZERO ELEMENTS IN THE UPPER PART OF THE HESSIAN
!         MATRIX.
!  RI  X(NF)  VECTOR OF VARIABLES.
!  II  IH(NF+1)  POINTERS OF DIAGONAL ELEMENTS OF THE MATRIX H.
!  IU  JH(MH)  INDICES OF NONZERO ELEMENTS OF THE MATRIX H
!         TOGETHER WITH AN ADDITIONAL SPACE USED FOR THE NUMERICAL
!         DIFFERENTIATION.
!  II  IPAR(7)  INTEGER PAREMETERS:
!      IPAR(1)  MAXIMUM NUMBER OF ITERATIONS.
!      IPAR(2)  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!      IPAR(3)  MAXIMUM NUMBER OF GRADIENT EVALUATIONS.
!      IPAR(4)  ESTIMATION INDICATOR. IPAR(4)=0-MINIMUM IS NOT
!         ESTIMATED. IPAR(4)=1-MINIMUM IS ESTIMATED BY THE VALUE
!         RPAR(6).
!      IPAR(5)  METHOD FOR COMPUTING THE TRUST REGION STEP.
!         IPAR(5)=1-THE DOG-LEG METHOD. MOS=2-THE MORE-SORENSEN METHOD.
!      IPAR(6)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PNED.
!      IPAR(7)  NUMBER DEFINING THE SPACE FOR FILL-IN (THE SIZE OF THIS
!         SPACE IS IFIL TIMES THE STANDARD SIZE). THE DEFAULT VALUE IS
!         IFIL=1. THE DEFAULT VALUE HAS TO BE INCREASED IF ITERM IS
!         LESS OR EQUAL TO -40.
!  RI  RPAR(9)  REAL PARAMETERS:
!      RPAR(1)  MAXIMUM STEPSIZE.
!      RPAR(2)  TOLERANCE FOR THE CHANGE OF VARIABLES.
!      RPAR(3)  TOLERANCE FOR THE CHANGE OF FUNCTION VALUES.
!      RPAR(4)  TOLERANCE FOR THE FUNCTION FALUE.
!      RPAR(5)  TOLERANCE FOR THE GRADIENT NORM.
!      RPAR(6)  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!      RPAR(7)  INITIAL TRUST-REGION RADIUS.
!      RPAR(8)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PNED.
!      RPAR(9)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PNED.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  II  ISPAS  INPUT SPARSE STRUCTURE. ISPAS=1-STANDARD COORDINATE
!         FORM. ISPAS=2-SPARSE STRUCTURE COMPRESSED BY ROWS.
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!         VALUES ITERM<=-40 DETECT A LACK OF SPACE. IN THIS CASE,
!         PARAMETER IPAR(7) HAS TO BE INCREASED.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PNED  DISCRETE NEWTON METHOD WITH DIRECT SOLUTION OF THE
!         TRUST-REGION SUBPROBLEM.
!  S   PFSED3  COMPRESSED SPARSE STRUCTURE OF THE HESSIAN MATRIX IS
!         COMPUTED FROM THE COORDINATE FORM.
!  S   MXVICP COPYING OF AN INTEGER VECTOR.
!
! EXTERNAL SUBROUTINES :
!  SE  OBJ  COMPUTATION OF THE VALUE OF THE OBJECTIVE FUNCTION.
!         CALLING SEQUENCE: CALL OBJ(NF,X,FF) WHERE NF IS THE NUMBER
!         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND FF IS
!         THE VALUE OF THE OBJECTIVE FUNCTION.
!  SE  DOBJ  COMPUTATION OF THE GRADIENT OF THE OBJECTIVE FUNCTION.
!         CALLING SEQUENCE: CALL DOBJ(NF,X,GF) WHERE NF IS THE NUMBER
!         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND GF(NF)
!         IS THE GRADIENT OF THE OBJECTIVE FUNCTION.
!
      SUBROUTINE PNEDU (NF, MH, X, IH, JH, IPAR, RPAR, F, GMAX, ISPAS,
     &IPRNT, ITERM)
      INTEGER NF,MH,IH(*),JH(*),IPAR(7),ISPAS,IPRNT,ITERM
      DOUBLE PRECISION X(*),RPAR(9),F,GMAX
      INTEGER NB,LGF,LHF,LS,LXO,LGO,LXS,LCOL,LPSL,LPERM,LINVP,LWN11,
     &LWN12,LWN13,LWN14,LJH,IFIL,IER
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      INTEGER IA(:)
      DOUBLE PRECISION RA(:)
      ALLOCATABLE IA,RA
      IFIL=IPAR(7)
      IF (IFIL.LE.0) IFIL=1
      IF (ISPAS.LE.1) THEN
        CALL PFSED3 (NF, MH, IH, JH, IER)
        IF (IER.NE.0) THEN
          WRITE (6,'(''INPUT ERROR : IER = '',I3)') IER
          STOP
        END IF
      ELSE
        MH=IH(NF+1)-1
      END IF
      ALLOCATE(IA(8*NF+5+(2*IFIL+3)*MH),RA(5*NF+1+(2*IFIL+3)*MH))
      NB=0
!
!     POINTERS FOR AUXILIARY ARRAYS
!
      LGF=1
      LS=LGF+NF
      LXO=LS+NF
      LGO=LXO+NF
      LXS=LGO+NF+1
      LHF=LXS+NF
      LCOL=1
      LPSL=LCOL+NF
      LPERM=LPSL+NF+1
      LINVP=LPERM+NF
      LWN11=LINVP+NF
      LWN12=LWN11+NF+1
      LWN13=LWN12+NF+1
      LWN14=LWN13+NF+1
      LJH=LWN14+NF+1
      CALL MXVICP (IH(NF+1)-1, JH, IA(LJH))
      CALL PNED (NF, NB, (2*IFIL+3)*MH, X, IA, RA, RA, RA(LGF), RA(LHF),
     & IH, IA(LJH), RA(LS), RA(LXO), RA(LGO), RA(LXS), IA(LCOL),
     &IA(LPSL), IA(LPERM), IA(LINVP), IA(LWN11), IA(LWN12), IA(LWN13),
     &IA(LWN14), 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),
     &IPRNT, ITERM)
      DEALLOCATE(IA,RA)
      RETURN
      END
! SUBROUTINE PNEDS              ALL SYSTEMS                   97/01/22
! PURPOSE :
! EASY TO USE SUBROUTINE FOR BOX CONSTRAINED MINIMIZATION OF
! LARGE-SCALE FUNCTIONS WITH SPARSE HESSIAN MATRICES
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  IU  MH  NUMBER OF NONZERO ELEMENTS IN THE UPPER PART OF THE HESSIAN
!         MATRIX.
!  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-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.
!  II  IH(NF+1)  POINTERS OF DIAGONAL ELEMENTS OF THE MATRIX H.
!  IU  JH(MH)  INDICES OF NONZERO ELEMENTS OF THE MATRIX H
!         TOGETHER WITH AN ADDITIONAL SPACE USED FOR THE NUMERICAL
!         DIFFERENTIATION.
!  II  IPAR(7)  INTEGER PAREMETERS:
!      IPAR(1)  MAXIMUM NUMBER OF ITERATIONS.
!      IPAR(2)  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!      IPAR(3)  MAXIMUM NUMBER OF GRADIENT EVALUATIONS.
!      IPAR(4)  ESTIMATION INDICATOR. IPAR(4)=0-MINIMUM IS NOT
!         ESTIMATED. IPAR(4)=1-MINIMUM IS ESTIMATED BY THE VALUE
!         RPAR(6).
!      IPAR(5)  METHOD FOR COMPUTING THE TRUST REGION STEP. MOS=1-THE
!         DOG-LEG METHOD. MOS=2-THE MORE-SORENSEN METHOD.
!      IPAR(6)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PNED.
!      IPAR(7)  NUMBER DEFINING THE SPACE FOR FILL-IN (THE SIZE OF THIS
!         SPACE IS IFIL TIMES THE STANDARD SIZE). THE DEFAULT VALUE IS
!         IFIL=1. THE DEFAULT VALUE HAS TO BE INCREASED IF ITERM IS
!         LESS OR EQUAL TO -40.
!  RI  RPAR(9)  REAL PARAMETERS:
!      RPAR(1)  MAXIMUM STEPSIZE.
!      RPAR(2)  TOLERANCE FOR THE CHANGE OF VARIABLES.
!      RPAR(3)  TOLERANCE FOR THE CHANGE OF FUNCTION VALUES.
!      RPAR(4)  TOLERANCE FOR THE FUNCTION FALUE.
!      RPAR(5)  TOLERANCE FOR THE GRADIENT NORM.
!      RPAR(6)  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!      RPAR(7)  INITIAL TRUST-REGION RADIUS.
!      RPAR(8)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PNED.
!      RPAR(9)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PNED.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  II  ISPAS  INPUT SPARSE STRUCTURE. ISPAS=1-STANDARD COORDINATE
!         FORM. ISPAS=2-SPARSE STRUCTURE COMPRESSED BY ROWS.
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!         VALUES ITERM<=-40 DETECT A LACK OF SPACE. IN THIS CASE,
!         PARAMETER IPAR(7) HAS TO BE INCREASED.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PNED  DISCRETE NEWTON METHOD WITH DIRECT SOLUTION OF THE
!         TRUST-REGION SUBPROBLEM.
!  S   PFSED3  COMPRESSED SPARSE STRUCTURE OF THE HESSIAN MATRIX IS
!         COMPUTED FROM THE COORDINATE FORM.
!  S   MXVICP COPYING OF AN INTEGER VECTOR.
!
! EXTERNAL SUBROUTINES :
!  SE  OBJ  COMPUTATION OF THE VALUE OF THE OBJECTIVE FUNCTION.
!         CALLING SEQUENCE: CALL OBJ(NF,X,FF) WHERE NF IS THE NUMBER
!         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND FF IS
!         THE VALUE OF THE OBJECTIVE FUNCTION.
!  SE  DOBJ  COMPUTATION OF THE GRADIENT OF THE OBJECTIVE FUNCTION.
!         CALLING SEQUENCE: CALL DOBJ(NF,X,GF) WHERE NF IS THE NUMBER
!         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND GF(NF)
!         IS THE GRADIENT OF THE OBJECTIVE FUNCTION.
!
      SUBROUTINE PNEDS (NF, MH, X, IX, XL, XU, IH, JH, IPAR, RPAR, F,
     &GMAX, ISPAS, IPRNT, ITERM)
      INTEGER NF,MH,IX(*),IH(*),JH(*),IPAR(7),ISPAS,IPRNT,ITERM
      DOUBLE PRECISION X(*),XL(*),XU(*),RPAR(9),F,GMAX
      INTEGER NB,LGF,LHF,LS,LXO,LGO,LXS,LCOL,LPSL,LPERM,LINVP,LWN11,
     &LWN12,LWN13,LWN14,LJH,IFIL,IER
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      INTEGER IA(:)
      DOUBLE PRECISION RA(:)
      ALLOCATABLE IA,RA
      IFIL=IPAR(7)
      IF (IFIL.LE.0) IFIL=1
      IF (ISPAS.LE.1) THEN
        CALL PFSED3 (NF, MH, IH, JH, IER)
        IF (IER.NE.0) THEN
          WRITE (6,'(''INPUT ERROR : IER = '',I3)') IER
          STOP
        END IF
      ELSE
        MH=IH(NF+1)-1
      END IF
      ALLOCATE(IA(8*NF+5+(2*IFIL+3)*MH),RA(5*NF+1+(2*IFIL+3)*MH))
      NB=1
!
!     POINTERS FOR AUXILIARY ARRAYS
!
      LGF=1
      LS=LGF+NF
      LXO=LS+NF
      LGO=LXO+NF
      LXS=LGO+NF+1
      LHF=LXS+NF
      LCOL=1
      LPSL=LCOL+NF
      LPERM=LPSL+NF+1
      LINVP=LPERM+NF
      LWN11=LINVP+NF
      LWN12=LWN11+NF+1
      LWN13=LWN12+NF+1
      LWN14=LWN13+NF+1
      LJH=LWN14+NF+1
      CALL MXVICP (IH(NF+1)-1, JH, IA(LJH))
      CALL PNED (NF, NB, (2*IFIL+3)*MH, X, IX, XL, XU, RA(LGF), RA(LHF),
     & IH, IA(LJH), RA(LS), RA(LXO), RA(LGO), RA(LXS), IA(LCOL),
     &IA(LPSL), IA(LPERM), IA(LINVP), IA(LWN11), IA(LWN12), IA(LWN13),
     &IA(LWN14), 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),
     &IPRNT, ITERM)
      DEALLOCATE(IA,RA)
      RETURN
      END
! SUBROUTINE PNED               ALL SYSTEMS                   01/09/22
! PURPOSE :
! GENERAL SUBROUTINE FOR LARGE-SCALE BOX CONSTRAINED MINIMIZATION OF
! FUNCTIONS WITH SPARSE HESSIAN MATRICES BASED ON THE DISCRETE NEWTON
! METHOD WITH DIRECT SOLUTION OF THE TRUST-REGION SUBPROBLEM.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  II  NB  CHOICE OF SIMPLE BOUNDS. NB=0-SIMPLE BOUNDS SUPPRESSED.
!         NB>0-SIMPLE BOUNDS ACCEPTED.
!  II  MMAX  MAXIMUM DIMENSION OF THE SPARSE TABLEAU.
!  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.
!  RU  GF(NF)  GRADIENT OF THE OBJECTIVE FUNCTION.
!  RA  HF(MMAX)  NONZERO ELEMENTS OF THE SPARSE HESSIAN MATRIX
!         TOGETHER WITH AN ADDITIONAL SPACE USED FOR THE NUMERICAL
!         DIFFERENTIATION.
!  II  IH(NF+1)  POINTERS OF DIAGONAL ELEMENTS OF THE MATRIX H.
!  IU  JH(MMAX)  INDICES OF NONZERO ELEMENTS OF THE MATRIX H
!         TOGETHER WITH AN ADDITIONAL SPACE USED FOR THE NUMERICAL
!         DIFFERENTIATION.
!  RU  S(NF)  DIRECTION VECTOR.
!  RU  XO(NF)  VECTORS OF VARIABLES DIFFERENCE.
!  RU  GO(NF)  GRADIENTS DIFFERENCE.
!  RA  XS(NF)  AUXILIARY VECTOR.
!  IA  COL(NF)  AUXILIARY ARRAY.
!  IA  PSL(NF+1)  POINTER VECTOR OF THE COMPACT FORM OF THE TRIANGULAR
!         FACTOR OF THE HESSIAN APPROXIMATION.
!  IA  PERM(NF)  PERMUTATION VECTOR.
!  IA  INVP(NF)  INVERSE PERMUTATION VECTOR.
!  IA  WN11(NF+1) AUXILIARY VECTOR.
!  IA  WN12(NF+1) AUXILIARY VECTOR.
!  IA  WN13(NF+1) AUXILIARY VECTOR.
!  IA  WN14(NF+1) AUXILIARY VECTOR.
!  RI  XMAX  MAXIMUM STEPSIZE.
!  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 NORM.
!  RI  FMIN  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!  RI  XDEL  TRUST REGION STEPSIZE.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  II  MIT  MAXIMUM NUMBER OF ITERATIONS.
!  II  MFV  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!  II  MFG  MAXIMUM NUMBER OF GRADIENT EVALUATIONS.
!  II  IEST  ESTIMATION INDICATOR. IEST=0-MINIMUM IS NOT ESTIMATED.
!         IEST=1-MINIMUM IS ESTIMATED BY THE VALUE FMIN.
!  II  MOS  METHOD FOR COMPUTING THE TRUST REGION STEP. MOS=1-THE
!         DOG-LEG METHOD. MOS=2-THE MORE-SORENSEN METHOD.
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!         VALUES ITERM<=-40 DETECT A LACK OF SPACE.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PCBS04  ELIMINATION OF BOX CONSTRAINT VIOLATIONS.
!  S   PDSGM1  DIRECTION DETERMINATION USING THE DOUBLE DOG-LEG
!         TRUST-REGION METHOD.
!  S   PDSGM7  DIRECTION DETERMINATION USING THE MORE-SORENSEN
!         TRUST-REGION METHOD.
!  S   PF1HS2  NUMERICAL COMPUTATION OF THE HESSIAN MATRIX USING
!         DIFFERENCES OF GRADIENTS.
!  S   PS0G01  STEPSIZE SELECTION USING TRUST REGION.
!  S   PYADC0  ADDITION OF A BOX CONSTRAINT.
!  S   PYFUT1  TEST ON TERMINATION.
!  S   PYPTSH  DETERMINATION OF GROUPS FOR NUMERICAL DIFFERENTIATION.
!  S   PYRMC0  DELETION OF A BOX CONSTRAINT.
!  S   PYTRCD  COMPUTATION OF PROJECTED DIFFERENCES FOR THE VARIABLE
!         METRIC UPDATE.
!  S   PYTRCG  COMPUTATION OF THE PROJECTED GRADIENT.
!  S   PYTRCS  COMPUTATION OF THE PROJECTED DIRECTION VECTOR.
!  S   PYTSCH  CORRECTION OF THE HESSIAN MATRIX.
!  S   MXSPCC  SPARSE MATRIX REORDERING, SYMBOLIC FACTORIZATION, DATA
!         STRUCTURES TRANSFORMATION. INITIATION OF THE DIRECT SPARSE
!         SOLVER.
!  S   MXSSMI  SPARSE SYMMETRIC MATRIX IS REPLACED BY THE UNIT MATRIX.
!  S   MXUDIR  VECTOR AUGMENTED BY THE SCALED VECTOR.
!  S   MXVCOP  COPYING OF A VECTOR.
!  S   MXVINB  PROJECTION OF A SPARSE SYMMETRIC MATRIX TO SATISFY BOX
!         CONSTRAINTS.
!  S   MXVINE  RESTORATION OF A SPARSE SYMMETRIC MATRIX OBTAINED BY
!         MXVINB
!
! EXTERNAL SUBROUTINES :
!  SE  OBJ  COMPUTATION OF THE VALUE OF THE OBJECTIVE FUNCTION.
!         CALLING SEQUENCE: CALL OBJ(NF,X,FF) WHERE NF IS THE NUMBER
!         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND FF IS
!         THE VALUE OF THE OBJECTIVE FUNCTION.
!  SE  DOBJ  COMPUTATION OF THE GRADIENT OF THE OBJECTIVE FUNCTION.
!         CALLING SEQUENCE: CALL DOBJ(NF,X,GF) WHERE NF IS THE NUMBER
!         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND GF(NF)
!         IS THE GRADIENT OF THE OBJECTIVE FUNCTION.
!
! METHOD :
! DISCRETE NEWTON METHOD WITH TRUST-REGION STRATEGIES BASED ON DIRECT
! MATRIX DECOMPOSITIONS.
!
      SUBROUTINE PNED (NF, NB, MMAX, X, IX, XL, XU, GF, HF, IH, JH, S,
     &XO, GO, XS, COL, PSL, PERM, INVP, WN11, WN12, WN13, WN14, XMAX,
     &TOLX, TOLF, TOLB, TOLG, FMIN, XDEL, GMAX, F, MIT, MFV, MFG, IEST,
     &MOS, IPRNT, ITERM)
      INTEGER NF,NB,MMAX,IX(*),IH(*),JH(*),COL(*),PSL(*),PERM(*),INVP(*)
     &,WN11(*),WN12(*),WN13(*),WN14(*),MIT,MFV,MFG,IEST,MOS,IPRNT,ITERM
      DOUBLE PRECISION X(*),XL(*),XU(*),GF(*),HF(*),S(*),XO(*),GO(*),
     &XS(*),TOLX,TOLF,TOLG,TOLB,XDEL,FMIN,XMAX,GMAX,F
      INTEGER IDECF,ITERD,ITERS,ITERH,KD,LD,NTESX,NTESF,MTESX,MTESF,
     &MRED,KIT,IREST,KBF,MES1,MES2,MES3,MAXST,IDIR,ISYS,ITES,KTERS,
     &IRES1,IRES2,NRED,INEW,IOLD,I,M,MH,N
      DOUBLE PRECISION R,RO,FO,FP,P,PO,PP,GNORM,SNORM,RMAX,UMAX,FMAX,
     &DMAX,ETA0,ETA2,ETA9,EPS4,EPS5,EPS8,EPS9,ALF2,BET1,BET2,GAM1,GAM2,
     &DEL1,DEL2,XDELO
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      IF (ABS(IPRNT).GT.1) WRITE (6,'(1X,''ENTRY TO PNED :'')')
!
!     INITIATION
!
      KBF=0
      IF (NB.GT.0) KBF=2
      NRES=0
      NDEC=0
      NIN=0
      NIT=0
      NFV=0
      NFG=0
      NFH=0
      IDIR=0
      ISYS=0
      ITES=1
      MTESX=2
      MTESF=2
      ITERM=0
      ITERD=0
      ITERS=2
      ITERH=0
      KTERS=0
      IREST=0
      IRES1=999
      IRES2=0
      IDECF=0
      MRED=10
      MES1=3
      MES2=2
      MES3=1
      ETA0=1.0D-15
      ETA2=1.0D-18
      ETA9=1.0D120
      EPS4=0.10D0
      EPS5=0.90D0
      EPS8=1.00D0
      EPS9=1.00D-8
      ALF2=1.0D6
      BET1=0.05D0
      BET2=0.75D0
      GAM1=2.0D0
      GAM2=1.0D6
      DEL1=0.9D0
      DEL2=1.1D0
      RMAX=ETA9
      DMAX=ETA9
      FMAX=1.0D60
      IF (IEST.LE.0) FMIN=-1.0D60
      IF (IEST.GT.0) IEST=1
      IF (XMAX.LE.0.0D0) XMAX=1.0D16
      XDEL=MIN(XDEL,XMAX)
      IF (TOLX.LE.0.0D0) TOLX=1.0D-16
      IF (TOLF.LE.0.0D0) TOLF=1.0D-14
      IF (TOLG.LE.0.0D0) TOLG=1.0D-6
      IF (TOLB.LE.0.0D0) TOLB=FMIN+1.0D-16
      IF (MIT.LE.0) MIT=5000
      IF (MFV.LE.0) MFV=5000
      IF (MFG.LE.0) MFG=10000
      IF (MOS.LE.0) MOS=2
      KD=2
      LD=-1
      KIT=0
      FO=FMIN
!
!     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
   10   CONTINUE
      END IF
      M=IH(NF+1)-1
      IF (KBF.GT.0) THEN
        CALL PCBS04 (NF, X, IX, XL, XU, EPS9, KBF)
        CALL PYADC0 (NF, N, X, IX, XL, XU, INEW)
        CALL MXVINE (IH(NF+1)-1, JH)
      END IF
      CALL PYPTSH (NF, MMAX, IH, JH, COL, S, XO, GO, WN11, WN12, GF,
     &ITERM)
      MH=0
      CALL MXSPCC (NF, M, MH, MMAX, HF, IH, JH, PSL, PERM, INVP, WN11,
     &WN12, WN13, WN14, ITERM)
      IF (ITERM.NE.0) GO TO 110
      CALL OBJ (NF, X, F)
      NFV=NFV+1
      CALL DOBJ (NF, X, GF)
      NFG=NFG+1
   20 CALL PF1HS2 (NF, MH, MMAX, X, IX, S, HF, IH, JH, GO, GF, COL,
     &WN11, WN12, XS, F, ETA0, KBF, ITERM, ISYS)
      IF (ISYS.EQ.0) GO TO 30
      CALL DOBJ (NF, X, GO)
      NFG=NFG+1
      GO TO 20
   30 CONTINUE
      IDECF=0
!
!     START OF THE ITERATION WITH TESTS FOR TERMINATION.
!
   40 CALL PYTRCG (NF, NF, IX, GF, UMAX, GMAX, KBF, IOLD)
      IF (ABS(IPRNT).GT.1) WRITE (6,'(1X,''NIT='',I5,2X,''NFV='',I5,2X,'
     &'NFG='',I5,2X,       ''F='', G16.9,2X,''G='',E10.3)') NIT,NFV,NFG,
     &F,GMAX
      CALL PYFUT1 (NF, F, FO, UMAX, GMAX, DMAX, TOLX, TOLF, TOLB, TOLG,
     &KD, NIT, KIT, MIT, NFV, MFV, NFG, MFG, NTESX, MTESX, NTESF, MTESF,
     & ITES, IRES1, IRES2, IREST, ITERS, ITERM)
      IF (ITERM.NE.0) GO TO 110
      IF (KBF.GT.0) CALL PYRMC0 (NF, N, IX, GF, EPS8, UMAX, GMAX, RMAX,
     &IOLD, IREST)
   50 IF (IREST.GT.0) THEN
        CALL MXSSMI (NF, HF, IH)
        IDECF=0
        LD=MIN(LD,1)
        IF (KIT.LT.NIT) THEN
          NRES=NRES+1
          KIT=NIT
        ELSE
          ITERM=-10
          IF (ITERS.LT.0) ITERM=ITERS-5
          IF (GMAX.LE.1.0D2*TOLG) ITERM=-ITERM
        END IF
      END IF
      IF (ITERM.NE.0) GO TO 110
      IF (KBF.GT.0) THEN
        CALL MXVINB (M, IX, JH)
        CALL PYTSCH (NF, IX, HF, IH, JH, KBF)
      END IF
!
!     DIRECTION DETERMINATION
!
      IF (MOS.LE.1) THEN
        CALL PDSGM1 (NF, MMAX, MH, IX, GF, HF, IH, JH, S, XO, GO, XS,
     &   PSL, PERM, WN11, WN12, XMAX, XDEL, GNORM, SNORM, FMIN, F, P,
     &   PP, ETA2, ALF2, KD, KBF, IEST, IDECF, NDEC, ITERD, ITERM)
      ELSE
        CALL PDSGM7 (NF, MMAX, MH, IX, GF, HF, IH, JH, S, XO, GO, PSL,
     &   PERM, WN11, WN12, XMAX, XDEL, XDELO, GNORM, SNORM, FMIN, F, P,
     &   PP, ETA2, DEL1, DEL2, KD, KBF, IEST, IDIR, IDECF, NDEC, ITERD,
     &   ITERM)
      END IF
!
!     TEST ON LOCALLY CONSTRAINED STEP AND PREPARATION OF STEPSIZE
!     SELECTION
!
      IF (ITERD.LT.0) THEN
        ITERM=ITERD
      ELSE
        IF (SNORM.LE.0.0D0) THEN
          IREST=MAX(IREST,1)
        ELSE
          IREST=0
        END IF
        IF (IREST.EQ.0) THEN
          RMAX=XMAX/SNORM
        END IF
      END IF
      IF (ITERM.NE.0) GO TO 110
      IF (IREST.NE.0) GO TO 50
      IF (NIT.EQ.1) KIT=NIT
      CALL PYTRCS (NF, X, IX, XO, XL, XU, GF, GO, S, RO, FP, FO, F, PO,
     &P, RMAX, ETA9, KBF)
      IF (RMAX.EQ.0.0D0) GO TO 100
   60 CALL PS0G01 (R, F, FO, PO, PP, XDEL, XDELO, XMAX, RMAX, SNORM,
     &BET1, BET2, GAM1, GAM2, EPS4, EPS5, KD, LD, IDIR, ITERS, ITERD,
     &MAXST, NRED, MRED, KTERS, MES1, MES2, MES3, ISYS)
      IF (ISYS.EQ.0) GO TO 70
      CALL MXUDIR (NF, R, S, XO, X, IX, KBF)
      CALL PCBS04 (NF, X, IX, XL, XU, EPS9, KBF)
      CALL OBJ (NF, X, F)
      NFV=NFV+1
      GO TO 60
   70 CONTINUE
      KD=2
      IF (ITERS.LE.0) THEN
        R=0.0D0
        F=FO
        P=PO
        CALL MXVCOP (NF, XO, X)
        IF (ITERS.LT.0) THEN
          ITERM=-6
          IF (GMAX.LE.1.0D2*TOLG) ITERM=-ITERM
          GO TO 110
        END IF
        IF (IDIR.EQ.0) IREST=MAX(IREST,1)
        LD=KD
        GO TO 50
      END IF
      IF (KD.GT.LD) THEN
        CALL DOBJ (NF, X, GF)
        NFG=NFG+1
   80   CALL PF1HS2 (NF, MH, MMAX, X, IX, S, HF, IH, JH, GO, GF, COL,
     &   WN11, WN12, XS, F, ETA0, KBF, ITERM, ISYS)
        IF (ISYS.EQ.0) GO TO 90
        CALL DOBJ (NF, X, GO)
        NFG=NFG+1
        GO TO 80
   90   CONTINUE
        IDECF=0
      END IF
      CALL PYTRCD (NF, X, IX, XO, GF, GO, R, F, FO, P, PO, DMAX, KBF,
     &KD, LD, ITERS)
  100 CONTINUE
      IF (KBF.GT.0) CALL PYADC0 (NF, N, X, IX, XL, XU, INEW)
      GO TO 40
  110 CONTINUE
      IF (IPRNT.GT.1.OR.IPRNT.LT.0) WRITE (6,'(1X,''EXIT FROM PNED :'')'
     &)
      IF (IPRNT.NE.0) WRITE (6,'(1X,''NIT='',I5,2X,''NFV='',I5,2X,''NFG=
     &'',I5,2X,       ''F='', G16.9,2X,''G='',E10.3,2X,''ITERM='',I3)')
     &NIT,NFV,NFG,F,GMAX,ITERM
      IF (IPRNT.LT.0) WRITE (6,'(1X,''X='',5(G14.7,1X):/(3X,5(G14.7,1X))
     &)') (X(I),I=1,NF)
      RETURN
      END
! SUBROUTINE PNETU              ALL SYSTEMS                   97/01/22
! PURPOSE :
! EASY TO USE SUBROUTINE FOR LARGE-SCALE UNCONSTRAINED MINIMIZATION.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  RI  X(NF)  VECTOR OF VARIABLES.
!  II  IPAR(7)  INTEGER PAREMETERS:
!      IPAR(1)  MAXIMUM NUMBER OF ITERATIONS.
!      IPAR(2)  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!      IPAR(3)  MAXIMUM NUMBER OF GRADIENT EVALUATIONS.
!      IPAR(4)  ESTIMATION INDICATOR. IPAR(4)=0-MINIMUM IS NOT
!         ESTIMATED. IPAR(4)=1-MINIMUM IS ESTIMATED BY THE VALUE
!         RPAR(6).
!      IPAR(5)  CHOICE OF DIRECTION VECTORS AFTER RESTARTS.
!         IPAR(5)=1-THE NEWTON DIRECTIONS ARE USED. IPAR(5)=2-THE
!         STEEPEST DESCENT DIRECTIONS ARE USED.
!      IPAR(6)  CHOICE OF PRECONDITIONING STRATEGY.
!         IPAR(6)=1-PRECONDITIONING IS NOT USED.
!         IPAR(6)=2-PRECONDITIONING BY THE LIMITED MEMORY BFGS METHOD
!         IS USED.
!      IPAR(7)  THE NUMBER OF LIMITED-MEMORY VARIABLE METRIC UPDATES
!         IN EACH ITERATION (THEY USE 2*MF STORED VECTORS).
!  RI  RPAR(9)  REAL PARAMETERS:
!      RPAR(1)  MAXIMUM STEPSIZE.
!      RPAR(2)  TOLERANCE FOR THE CHANGE OF VARIABLES.
!      RPAR(3)  TOLERANCE FOR THE CHANGE OF FUNCTION VALUES.
!      RPAR(4)  TOLERANCE FOR THE FUNCTION FALUE.
!      RPAR(5)  TOLERANCE FOR THE GRADIENT NORM.
!      RPAR(6)  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!      RPAR(7)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PNET.
!      RPAR(8)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PNET.
!      RPAR(9)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PNET.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  II  IHES  THE WAY FOR COMPUTING THE PRODUCT OF THE HESSIAN MATRIX
!         AND A VECTOR. IHES=0-THE PRODUCT IS COMPUTED BY USING THE
!         GRADIENT DIFFERENCES. IHES=1-THE PRODUCT IS COMPUTED BY USING
!         THE USER SUPPLIED SUBROUTINE HVEC.
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PNET  LIMITED MEMORY VARIABLE METRIC METHOD BASED ON THE STRANG
!         RECURRENCES.
!
! EXTERNAL SUBROUTINES :
!  SE  OBJ  COMPUTATION OF THE VALUE OF THE OBJECTIVE FUNCTION.
!         CALLING SEQUENCE: CALL OBJ(NF,X,FF) WHERE NF IS THE NUMBER
!         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND FF IS
!         THE VALUE OF THE OBJECTIVE FUNCTION.
!  SE  DOBJ  COMPUTATION OF THE GRADIENT OF THE OBJECTIVE FUNCTION.
!         CALLING SEQUENCE: CALL DOBJ(NF,X,GF) WHERE NF IS THE NUMBER
!         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND GF(NF)
!         IS THE GRADIENT OF THE OBJECTIVE FUNCTION.
!  SE  HVEC MULTIPLICATION OF A VECTOR BY THE HESSIAN MATRIX.
!
      SUBROUTINE PNETU (NF, X, IPAR, RPAR, F, GMAX, IHES, IPRNT, ITERM)
      INTEGER NF,IPAR(7),IHES,IPRNT,ITERM
      DOUBLE PRECISION X(*),RPAR(9),F,GMAX
      INTEGER MF,NB,LGF,LGN,LS,LXO,LGO,LXS,LGS,LXM,LGM,LU1,LU2
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      DOUBLE PRECISION RA(:)
      ALLOCATABLE RA
      MF=IPAR(7)
      IF (MF.LE.0) MF=10
      ALLOCATE (RA(8*NF+2*NF*MF+2*MF))
      NB=0
!
!     POINTERS FOR AUXILIARY ARRAYS
!
      LGF=1
      LGN=LGF+NF
      LS=LGN+NF
      LXO=LS+NF
      LGO=LXO+NF
      LXS=LGO+NF
      LGS=LXS+NF
      LXM=LGS+NF
      LGM=LXM+NF*MF
      LU1=LGM+NF*MF
      LU2=LU1+MF
      CALL PNET (NF, NB, X, IPAR, RA, RA, RA(LGF), RA(LGN), RA(LS),
     &RA(LXO), RA(LGO), RA(LXS), RA(LGS), RA(LXM), RA(LGM), RA(LU1),
     &RA(LU2), RPAR(1), RPAR(2), RPAR(3), RPAR(4), RPAR(5), RPAR(6),
     &GMAX, F, IHES, IPAR(1), IPAR(2), IPAR(3), IPAR(4), IPAR(5), 
     &IPAR(6), MF, IPRNT, ITERM)
      DEALLOCATE (RA)
      RETURN
      END
! SUBROUTINE PNETS              ALL SYSTEMS                   97/01/22
! PURPOSE :
! EASY TO USE SUBROUTINE FOR LARGE-SCALE BOX CONSTRAINED MINIMIZATION.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  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-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.
!  II  IPAR(7)  INTEGER PAREMETERS:
!      IPAR(1)  MAXIMUM NUMBER OF ITERATIONS.
!      IPAR(2)  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!      IPAR(3)  MAXIMUM NUMBER OF GRADIENT EVALUATIONS.
!      IPAR(4)  ESTIMATION INDICATOR. IPAR(4)=0-MINIMUM IS NOT
!         ESTIMATED. IPAR(4)=1-MINIMUM IS ESTIMATED BY THE VALUE
!         RPAR(6).
!      IPAR(5)  CHOICE OF DIRECTION VECTORS AFTER RESTARTS.
!         IPAR(5)=1-THE NEWTON DIRECTIONS ARE USED. IPAR(5)=2-THE
!         STEEPEST DESCENT DIRECTIONS ARE USED.
!      IPAR(6)  CHOICE OF PRECONDITIONING STRATEGY.
!         IPAR(6)=1-PRECONDITIONING IS NOT USED.
!         IPAR(6)=2-PRECONDITIONING BY THE LIMITED MEMORY BFGS METHOD
!         IS USED.
!      IPAR(7)  THE NUMBER OF LIMITED-MEMORY VARIABLE METRIC UPDATES
!         IN EACH ITERATION (THEY USE 2*MF STORED VECTORS).
!  RI  RPAR(9)  REAL PARAMETERS:
!      RPAR(1)  MAXIMUM STEPSIZE.
!      RPAR(2)  TOLERANCE FOR THE CHANGE OF VARIABLES.
!      RPAR(3)  TOLERANCE FOR THE CHANGE OF FUNCTION VALUES.
!      RPAR(4)  TOLERANCE FOR THE FUNCTION FALUE.
!      RPAR(5)  TOLERANCE FOR THE GRADIENT NORM.
!      RPAR(6)  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!      RPAR(7)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PNET.
!      RPAR(8)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PNET.
!      RPAR(9)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PNET.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  II  IHES  THE WAY FOR COMPUTING THE PRODUCT OF THE HESSIAN MATRIX
!         AND A VECTOR. IHES=0-THE PRODUCT IS COMPUTED BY USING THE
!         GRADIENT DIFFERENCES. IHES=1-THE PRODUCT IS COMPUTED BY USING
!         THE USER SUPPLIED SUBROUTINE HVEC.
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PNET  LIMITED MEMORY VARIABLE METRIC METHOD BASED ON THE STRANG
!         RECURRENCES.
!
! EXTERNAL SUBROUTINES :
!  SE  OBJ  COMPUTATION OF THE VALUE OF THE OBJECTIVE FUNCTION.
!         CALLING SEQUENCE: CALL OBJ(NF,X,FF) WHERE NF IS THE NUMBER
!         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND FF IS
!         THE VALUE OF THE OBJECTIVE FUNCTION.
!  SE  DOBJ  COMPUTATION OF THE GRADIENT OF THE OBJECTIVE FUNCTION.
!         CALLING SEQUENCE: CALL DOBJ(NF,X,GF) WHERE NF IS THE NUMBER
!         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND GF(NF)
!         IS THE GRADIENT OF THE OBJECTIVE FUNCTION.
!  SE  HVEC MULTIPLICATION OF A VECTOR BY THE HESSIAN MATRIX.
!
      SUBROUTINE PNETS (NF, X, IX, XL, XU, IPAR, RPAR, F, GMAX, IHES,
     &IPRNT, ITERM)
      INTEGER NF,IX(*),IPAR(7),IHES,IPRNT,ITERM
      DOUBLE PRECISION X(*),XL(*),XU(*),RPAR(9),F,GMAX
      INTEGER MF,NB,LGF,LGN,LS,LXO,LGO,LXS,LGS,LXM,LGM,LU1,LU2
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      DOUBLE PRECISION RA(:)
      ALLOCATABLE RA
      MF=IPAR(7)
      IF (MF.LE.0) MF=10
      ALLOCATE (RA(8*NF+2*NF*MF+2*MF))
      NB=1
!
!     POINTERS FOR AUXILIARY ARRAYS
!
      LGF=1
      LGN=LGF+NF
      LS=LGN+NF
      LXO=LS+NF
      LGO=LXO+NF
      LXS=LGO+NF
      LGS=LXS+NF
      LXM=LGS+NF
      LGM=LXM+NF*MF
      LU1=LGM+NF*MF
      LU2=LU1+MF
      CALL PNET (NF, NB, X, IX, XL, XU, RA(LGF), RA(LGN), RA(LS),
     &RA(LXO), RA(LGO), RA(LXS), RA(LGS), RA(LXM), RA(LGM), RA(LU1),
     &RA(LU2), RPAR(1), RPAR(2), RPAR(3), RPAR(4), RPAR(5), RPAR(6),
     &GMAX, F, IHES, IPAR(1), IPAR(2), IPAR(3), IPAR(4), IPAR(5),
     &IPAR(6), MF, IPRNT, ITERM)
      DEALLOCATE (RA)
      RETURN
      END
! SUBROUTINE PNET               ALL SYSTEMS                   01/09/22
! PURPOSE :
! GENERAL SUBROUTINE FOR LARGE-SCALE BOX CONSTRAINED MINIMIZATION THAT
! USE THE LIMITED MEMORY VARIABLE METRIC METHOD BASED ON THE STRANG
! RECURRENCES.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  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  GF(NF)  GRADIENT OF THE OBJECTIVE FUNCTION.
!  RA  GN(NF)  OLD GRADIENT OF THE OBJECTIVE FUNCTION.
!  RO  S(NF)  DIRECTION VECTOR.
!  RA  XO(NF)  ARRAY CONTAINING INCREMENTS OF VARIABLES.
!  RA  GO(NF)  ARRAY CONTAINING INCREMENTS OF GRADIENTS.
!  RA  XS(NF)  AUXILIARY VECTOR.
!  RA  GS(NF)  AUXILIARY VECTOR.
!  RA  XM(NF*MF)  ARRAY CONTAINING INCREMENTS OF VARIABLES.
!  RA  GM(NF*MF)  ARRAY CONTAINING INCREMENTS OF GRADIENTS.
!  RA  U1(MF)  AUXILIARY VECTOR.
!  RA  U2(MF)  AUXILIARY VECTOR.
!  RI  XMAX  MAXIMUM STEPSIZE.
!  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 NORM.
!  RI  FMIN  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  II  IHES  THE WAY FOR COMPUTING THE PRODUCT OF THE HESSIAN MATRIX
!         AND A VECTOR. IHES=0-THE PRODUCT IS COMPUTED BY USING THE
!         GRADIENT DIFFERENCES. IHES=1-THE PRODUCT IS COMPUTED BY USING
!         THE USER SUPPLIED SUBROUTINE HVEC.
!  II  MIT  MAXIMUM NUMBER OF ITERATIONS.
!  II  MFV  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!  II  MFG  MAXIMUM NUMBER OF GRADIENT EVALUATIONS.
!  II  IEST  ESTIMATION INDICATOR. IEST=0-MINIMUM IS NOT ESTIMATED.
!         IEST=1-MINIMUM IS ESTIMATED BY THE VALUE FMIN.
!  II  MOS1  CHOICE OF RESTARTS AFTER A CONSTRAINT CHANGE.
!         MOS1=1-RESTARTS ARE SUPPRESSED. MOS1=2-RESTARTS WITH
!         STEEPEST DESCENT DIRECTIONS ARE USED.
!  II  MOS1  CHOICE OF DIRECTION VECTORS AFTER RESTARTS. MOS1=1-THE
!         NEWTON DIRECTIONS ARE USED. MOS1=2-THE STEEPEST DESCENT
!         DIRECTIONS ARE USED.
!  II  MOS2  CHOICE OF PRECONDITIONING STRATEGY. MOS2=1-PRECONDITIONING
!         IS NOT USED. MOS2=2-PRECONDITIONING BY THE LIMITED MEMORY
!         BFGS METHOD IS USED.
!  II  MF  THE NUMBER OF LIMITED-MEMORY VARIABLE METRIC UPDATES
!         IN EACH ITERATION (THEY USE 2*MF STORED VECTORS).
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUEBT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) SUBSEQUEBT ITERATIONS.
!         ITERM=3-IF F IS LESS THAN OR EQUAL TO TOLB.
!         ITERM=4-IF GMAX IS LESS THAN OR EQUAL TO TOLG.
!         ITERM=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITION.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PCBS04  ELIMINATION OF BOX CONSTRAINT VIOLATIONS.
!  S   PS1L01  STEPSIZE SELECTION USING LINE SEARCH.
!  S   PYADC0  ADDITION OF A BOX CONSTRAINT.
!  S   PYFUT1  TEST ON TERMINATION.
!  S   PYRMC0  DELETION OF A BOX CONSTRAINT.
!  S   PYTRCD  COMPUTATION OF PROJECTED DIFFERENCES FOR THE VARIABLE MET
!         UPDATE.
!  S   PYTRCG  COMPUTATION OF THE PROJECTED GRADIENT.
!  S   PYTRCS  COMPUTATION OF THE PROJECTED DIRECTION VECTOR.
!  S   MXDRCB BACKWARD PART OF THE STRANG FORMULA FOR PREMULTIPLICATION
!         OF THE VECTOR X BY AN IMPLICIT BFGS UPDATE.
!  S   MXDRCF FORWARD PART OF THE STRANG FORMULA FOR PREMULTIPLICATION
!         OF THE VECTOR X BY AN IMPLICIT BFGS UPDATE.
!  S   MXDRSU SHIFT OF COLUMNS OF THE RECTANGULAR MATRICES A AND B.
!         SHIFT OF ELEMENTS OF THE VECTOR U. THESE SHIFTS ARE USED IN
!         THE LIMITED MEMORY BFGS METHOD.
!  S   MXUDIR  VECTOR AUGMENTED BY THE SCALED VECTOR.
!  RF  MXUDOT  DOT PRODUCT OF TWO VECTORS.
!  S   MXVNEG  COPYING OF A VECTOR WITH CHANGE OF THE SIGN.
!  S   MXVCOP  COPYING OF A VECTOR.
!  S   MXVSCL  SCALING OF A VECTOR.
!  S   MXVSET  INITIATINON OF A VECTOR.
!  S   MXVDIF  DIFFERENCE OF TWO VECTORS.
!
! EXTERNAL SUBROUTINES :
!  SE  OBJ  COMPUTATION OF THE VALUE OF THE OBJECTIVE FUNCTION.
!         CALLING SEQUENCE: CALL OBJ(NF,X,FF) WHERE NF IS THE NUMBER
!         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND FF IS
!         THE VALUE OF THE OBJECTIVE FUNCTION.
!  SE  DOBJ  COMPUTATION OF THE GRADIENT OF THE OBJECTIVE FUNCTION.
!         CALLING SEQUENCE: CALL DOBJ(NF,X,GF) WHERE NF IS THE NUMBER
!         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND GF(NF)
!         IS THE GRADIENT OF THE OBJECTIVE FUNCTION.
!  SE  HVEC MULTIPLICATION OF A VECTOR BY THE HESSIAN MATRIX.
!
! METHOD :
! LIMITED MEMORY VARIABLE METRIC METHOD BASED ON THE STRANG
! RECURRENCES.
!
      SUBROUTINE PNET (NF, NB, X, IX, XL, XU, GF, GN, S, XO, GO, XS, GS,
     &XM, GM, U1, U2, XMAX, TOLX, TOLF, TOLB, TOLG, FMIN, GMAX, F,
     &IHES, MIT, MFV, MFG, IEST, MOS1, MOS2, MF, IPRNT, ITERM)
      INTEGER NF,NB,IX(*),IHES,MIT,MFV,MFG,IEST,MOS1,MOS2,MF,IPRNT,
     &ITERM
      DOUBLE PRECISION X(*),XL(*),XU(*),GF(*),GN(*),S(*),XO(*),GO(*),
     &XS(*),GS(*),XM(*),GM(*),U1(*),U2(*),XMAX,TOLX,TOLF,TOLG,TOLB,FMIN,
     &GMAX,F
      INTEGER ITERD,ITERS,KD,LD,NTESX,NTESF,MTESX,MTESF,MRED,KIT,IREST,
     &KBF,MES,MES1,MES2,MES3,MAXST,ISYS,ITES,INITS,KTERS,IRES1,IRES2,
     &INEW,IOLD,I,N,NRED,MX,MMX
      DOUBLE PRECISION R,RO,RP,FO,FP,P,PO,PP,GNORM,SNORM,RMIN,RMAX,UMAX,
     &FMAX,DMAX,ETA0,ETA9,EPS8,EPS9,ALF,ALF1,ALF2,RHO,RHO1,RHO2,PAR,
     &PAR1,PAR2,A,B,TOLD,TOLS,TOLP,EPS
      DOUBLE PRECISION MXUDOT
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      IF (ABS(IPRNT).GT.1) WRITE (6,'(1X,''ENTRY TO PNET :'')')
!
!     INITIATION
!
      KBF=0
      IF (NB.GT.0) KBF=2
      NRES=0
      NDEC=0
      NIN=0
      NIT=0
      NFV=0
      NFG=0
      NFH=0
      ISYS=0
      ITES=1
      MTESX=2
      MTESF=2
      INITS=2
      ITERM=0
      ITERD=0
      ITERS=2
      KTERS=3
      IREST=0
      IRES1=999
      IRES2=0
      MRED=10
      MES=4
      MES1=2
      MES2=2
      MES3=2
      EPS=0.80D0
      ETA0=1.0D-15
      ETA9=1.0D120
      EPS8=1.0D0
      EPS9=1.0D-8
      ALF1=1.0D-10
      ALF2=1.0D10
      RMAX=ETA9
      DMAX=ETA9
      FMAX=1.0D20
      IF (IEST.LE.0) FMIN=-1.0D60
      IF (IEST.GT.0) IEST=1
      IF (XMAX.LE.0.0D0) XMAX=1.0D16
      IF (TOLX.LE.0.0D0) TOLX=1.0D-16
      IF (TOLF.LE.0.0D0) TOLF=1.0D-14
      IF (TOLG.LE.0.0D0) TOLG=1.0D-6
      IF (TOLB.LE.0.0D0) TOLB=FMIN+1.0D-16
      TOLD=1.0D-4
      TOLS=1.0D-4
      TOLP=0.9D0
      IF (MIT.LE.0) MIT=5000
      IF (MFV.LE.0) MFV=5000
      IF (MFG.LE.0) MFG=30000
      IF (MOS1.LE.0) MOS1=1
      IF (MOS2.LE.0) MOS2=1
      KD=1
      LD=-1
      KIT=-(IRES1*NF+IRES2)
      FO=FMIN
!
!     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
   10   CONTINUE
        CALL PCBS04 (NF, X, IX, XL, XU, EPS9, KBF)
        CALL PYADC0 (NF, N, X, IX, XL, XU, INEW)
      END IF
      CALL OBJ (NF, X, F)
      NFV=NFV+1
      CALL DOBJ (NF, X, GF)
      NFG=NFG+1
      LD=KD
   20 CALL PYTRCG (NF, NF, IX, GF, UMAX, GMAX, KBF, IOLD)
      CALL MXVCOP (NF, GF, GN)
      IF (ABS(IPRNT).GT.1) WRITE (6,'(1X,''NIT='',I5,2X,''NFV='',I5,2X,'
     &'NFG='',I5,2X,''F='',G16.9,2X,''G='',E10.3)') NIT,NFV,NFG,F,GMAX
      CALL PYFUT1 (NF, F, FO, UMAX, GMAX, DMAX, TOLX, TOLF, TOLB, TOLG,
     &KD, NIT, KIT, MIT, NFV, MFV, NFG, MFG, NTESX, MTESX, NTESF, MTESF,
     &ITES, IRES1, IRES2, IREST, ITERS, ITERM)
      IF (ITERM.NE.0) GO TO 100
      IF (KBF.GT.0) THEN
        CALL PYRMC0 (NF, N, IX, GN, EPS8, UMAX, GMAX, RMAX, IOLD, IREST)
        IF (UMAX.GT.EPS8*GMAX) IREST=MAX(IREST,1)
      END IF
      CALL MXVCOP (NF, X, XO)
!
!     DIRECTION DETERMINATION
!
   30 IF (IREST.NE.0) THEN
        IF (KIT.LT.NIT) THEN
          MX=0
          NRES=NRES+1
          KIT=NIT
        ELSE
          ITERM=-10
          IF (ITERS.LT.0) ITERM=ITERS-5
          GO TO 100
        END IF
        IF (MOS1.GT.1) THEN
          CALL MXVNEG (NF, GN, S)
          GNORM=SQRT(MXUDOT(NF,GN,GN,IX,KBF))
          SNORM=GNORM
          GO TO 60
        END IF
      END IF
      RHO1=MXUDOT(NF,GN,GN,IX,KBF)
      GNORM=SQRT(RHO1)
      PAR=MIN(EPS,SQRT(GNORM))
      IF (PAR.GT.1.0D1*1.0D-3) THEN
        PAR=MIN(PAR,1.0D0/DBLE(NIT))
      END IF
      PAR=PAR*PAR
!
!     CG INITIATION
!
      RHO=RHO1
      SNORM=0.0D0
      CALL MXVSET (NF, 0.0D0, S)
      CALL MXVNEG (NF, GN, GS)
      CALL MXVCOP (NF, GS, XS)
      IF (MOS2.GT.1) THEN
        IF (MX.EQ.0) THEN
          B=0.0D0
        ELSE
          B=MXUDOT(NF,XM,GM,IX,KBF)
        END IF
        IF (B.GT.0.0D0) THEN
          U1(1)=1.0D0/B
          CALL MXDRCB (NF, MX, XM, GM, U1, U2, XS, IX, KBF)
          A=MXUDOT(NF,GM,GM,IX,KBF)
          IF (A.GT.0.0D0) CALL MXVSCL (NF, B/A, XS, XS)
          CALL MXDRCF (NF, MX, XM, GM, U1, U2, XS, IX, KBF)
        END IF
      END IF
      RHO=MXUDOT(NF,GS,XS,IX,KBF)
      MMX=NF+3
      NRED=0
   40 NRED=NRED+1
      IF (NRED.GT.MMX) GO TO 50
      IF (IHES.LE.0) THEN
        FO=F
        PP=SQRT(ETA0/MXUDOT(NF,XS,XS,IX,KBF))
        LD=0
        CALL MXUDIR (NF, PP, XS, XO, X, IX, KBF)
        CALL DOBJ (NF, X, GF)
        NFG=NFG+1
        LD=KD
        CALL MXVDIF (NF, GF, GN, GO)
        F=FO
        CALL MXVSCL (NF, 1.0D0/PP, GO, GO)
      ELSE
        CALL HVEC (NF, XO, XS, GO)
      END IF
      ALF=MXUDOT(NF,XS,GO,IX,KBF)
      IF (ALF.LE.1.0D0/ETA9) THEN
!
!     CG FAILS (THE MATRIX IS NOT POSITIVE DEFINITE)
!
        IF (NRED.EQ.1) THEN
          CALL MXVNEG (NF, GN, S)
          SNORM=GNORM
        END IF
        ITERD=0
        GO TO 60
      ELSE
        ITERD=2
      END IF
!
!     CG STEP
!
      ALF=RHO/ALF
      CALL MXUDIR (NF, ALF, XS, S, S, IX, KBF)
      CALL MXUDIR (NF, -ALF, GO, GS, GS, IX, KBF)
      RHO2=MXUDOT(NF,GS,GS,IX,KBF)
      SNORM=SQRT(MXUDOT(NF,S,S,IX,KBF))
      IF (RHO2.LE.PAR*RHO1) GO TO 60
      IF (NRED.GE.MMX) GO TO 50
      IF (MOS2.GT.1) THEN
        IF (B.GT.0.0D0) THEN
          CALL MXVCOP (NF, GS, GO)
          CALL MXDRCB (NF, MX, XM, GM, U1, U2, GO, IX, KBF)
          IF (A.GT.0.0D0) CALL MXVSCL (NF, B/A, GO, GO)
          CALL MXDRCF (NF, MX, XM, GM, U1, U2, GO, IX, KBF)
          RHO2=MXUDOT(NF,GS,GO,IX,KBF)
          ALF=RHO2/RHO
          CALL MXUDIR (NF, ALF, XS, GO, XS, IX, KBF)
        ELSE
          ALF=RHO2/RHO
          CALL MXUDIR (NF, ALF, XS, GS, XS, IX, KBF)
        END IF
      ELSE
        ALF=RHO2/RHO
        CALL MXUDIR (NF, ALF, XS, GS, XS, IX, KBF)
      END IF
      RHO=RHO2
      GO TO 40
   50 CONTINUE
!
!     AN INEXACT SOLUTION IS OBTAINED
!
   60 CONTINUE
!
!     ------------------------------
!     END OF DIRECTION DETERMINATION
!     ------------------------------
!
      CALL MXVCOP (NF, XO, X)
      CALL MXVCOP (NF, GN, GF)
      IF (KD.GT.0) P=MXUDOT(NF,GN,S,IX,KBF)
      IF (ITERD.LT.0) THEN
        ITERM=ITERD
      ELSE
!
!     TEST ON DESCENT DIRECTION
!
        IF (SNORM.LE.0.0D0) THEN
          IREST=MAX(IREST,1)
        ELSE IF (P+TOLD*GNORM*SNORM.LE.0.0D0) THEN
          IREST=0
        ELSE
!
!     UNIFORM DESCENT CRITERION
!
          IREST=MAX(IREST,1)
        END IF
        IF (IREST.EQ.0) THEN
!
!     PREPARATION OF LINE SEARCH
!
          NRED=0
          RMIN=ALF1*GNORM/SNORM
          RMAX=MIN(ALF2*GNORM/SNORM,XMAX/SNORM)
        END IF
      END IF
      LD=KD
      IF (ITERM.NE.0) GO TO 100
      IF (IREST.NE.0) GO TO 30
      CALL PYTRCS (NF, X, IX, XO, XL, XU, GF, GO, S, RO, FP, FO, F, PO,
     &P, RMAX, ETA9, KBF)
      IF (RMAX.EQ.0.0D0) GO TO 90
   70 CALL PS1L01 (R, RP, F, FO, FP, P, PO, PP, FMIN, FMAX, RMIN, RMAX,
     &TOLS, TOLP, PAR1, PAR2, KD, LD, NIT, KIT, NRED, MRED, MAXST, IEST,
     &INITS, ITERS, KTERS, MES, ISYS)
      IF (ISYS.EQ.0) GO TO 80
      CALL MXUDIR (NF, R, S, XO, X, IX, KBF)
      CALL PCBS04 (NF, X, IX, XL, XU, EPS9, KBF)
      CALL OBJ (NF, X, F)
      NFV=NFV+1
      CALL DOBJ (NF, X, GF)
      NFG=NFG+1
      LD=KD
      P=MXUDOT(NF,GF,S,IX,KBF)
      GO TO 70
   80 CONTINUE
      IF (ITERS.LE.0) THEN
        R=0.0D0
        F=FO
        P=PO
        CALL MXVCOP (NF, XO, X)
        CALL MXVCOP (NF, GO, GF)
        IREST=MAX(IREST,1)
        LD=KD
        GO TO 30
      END IF
      CALL PYTRCD (NF, X, IX, XO, GF, GO, R, F, FO, P, PO, DMAX, KBF,
     &KD, LD, ITERS)
      IF (MOS2.GT.1) THEN
        MX=MIN(MX+1,MF)
        CALL MXDRSU (NF, MX, XM, GM, U1)
        CALL MXVCOP (NF, XO, XM)
        CALL MXVCOP (NF, GO, GM)
      END IF
   90 CONTINUE
      IF (KBF.GT.0) THEN
        CALL PYADC0 (NF, N, X, IX, XL, XU, INEW)
        IF (INEW.GT.0) IREST=MAX(IREST,1)
      END IF
      GO TO 20
  100 CONTINUE
      IF (IPRNT.GT.1.OR.IPRNT.LT.0) WRITE (6,'(1X,''EXIT FROM PNET :'')'
     &)
      IF (IPRNT.NE.0) WRITE (6,'(1X,''NIT='',I5,2X,''NFV='',I5,2X,''NFG=
     &'',I5,2X,''F='',G16.9,2X,''G='',E10.3,2X,''ITERM='',I3)')
     &NIT,NFV,NFG,F,GMAX,ITERM
      IF (IPRNT.LT.0) WRITE (6,'(1X,''X='',5(G14.7,1X):/(3X,5(G14.7,1X))
     &)') (X(I),I=1,NF)
      RETURN
      END
! SUBROUTINE PSECU              ALL SYSTEMS                   97/01/22
! PURPOSE :
! EASY TO USE SUBROUTINE FOR LARGE-SCALE UNCONSTRAINED MINIMIZATION
! OF PARTIALLY SEPARABLE FUNCTIONS.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  II  NA  NUMBER OF APPROXIMATED FUNCTIONS.
!  IU  MA  NUMBER OF NONZERO ELEMENTS IN THE JACOBIAN MATRIX.
!  RI  X(NF)  VECTOR OF VARIABLES.
!  RO  AF(NA)  VECTOR CONTAINING VALUES OF THE APPROXIMATED
!         FUNCTIONS.
!  RI  IAG(NA+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE JACOBIAN
!         MATRIX.
!  RI  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE JACOBIAN MATRIX.
!  II  IPAR(7)  INTEGER PAREMETERS:
!      IPAR(1)  MAXIMUM NUMBER OF ITERATIONS.
!      IPAR(2)  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!      IPAR(3)  MAXIMUM NUMBER OF GRADIENT EVALUATIONS.
!      IPAR(4)  ESTIMATION INDICATOR. IPAR(4)=0-MINIMUM IS NOT
!         ESTIMATED. IPAR(4)=1-MINIMUM IS ESTIMATED BY THE VALUE
!         RPAR(6).
!      IPAR(5)  TYPE OF VARIABLE METRIC UPDATE. IPAR(5)=1-THE BFGS
!         UPDATE. IPAR(5)=2-A COMBINATION OF THE BFGS AND THE RANK-ONE
!         UPDATES. IPAR(5)=3-THE DISCRETE NEWTON METHOD.
!      IPAR(6)  TYPE OF PRECONDITIONING. IPAR(6)=1-PRECONDITIONING IS
!         NOT USED. IPAR(6)=2-PRECONDITIONING BY THE INCOMPLETE
!         GILL-MURRAY DECOMPOSITION. IPAR(6)=3-PRECONDITIONING BY THE
!         INCOMPLETE GILL-MURRAY DECOMPOSITION WITH A PRELIMINARY
!         SOLUTION OF THE PRECONDITIONED SYSTEM WHICH IS USED IF IT
!         SATISFIES THE TERMINATION CRITERION.
!      IPAR(7)  NUMBER DEFINING THE SPACE FOR FILL-IN (THE SIZE OF THIS
!         SPACE IS IFIL TIMES THE STANDARD SIZE). THE DEFAULT VALUE IS
!         IFIL=1. THE DEFAULT VALUE HAS TO BE INCREASED IF ITERM IS
!         LESS OR EQUAL TO -40.
!  RI  RPAR(9)  REAL PARAMETERS:
!      RPAR(1)  MAXIMUM STEPSIZE.
!      RPAR(2)  TOLERANCE FOR THE CHANGE OF VARIABLES.
!      RPAR(3)  TOLERANCE FOR THE CHANGE OF FUNCTION VALUES.
!      RPAR(4)  TOLERANCE FOR THE FUNCTION FALUE.
!      RPAR(5)  TOLERANCE FOR THE GRADIENT NORM.
!      RPAR(6)  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!      RPAR(7)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PSEC.
!      RPAR(8)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PSEC.
!      RPAR(9)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PSEC.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  II  ISPAS  INPUT SPARSE STRUCTURE. ISPAS=1-STANDARD COORDINATE
!         FORM. ISPAS=2-SPARSE STRUCTURE COMPRESSED BY ROWS.
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!         VALUES ITERM<=-40 DETECT A LACK OF SPACE. IN THIS CASE,
!         PARAMETER IPAR(7) HAS TO BE INCREASED.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PSEC  VARIABLE METRIC METHOD FOR PARTIABLY SEPERABLE FUNCTIONS.
!  S   PASED3  COMPRESSED SPARSE STRUCTURE OF THE JACOBIAN MATRIX IS
!         COMPUTED FROM THE COORDINATE FORM.
!  S   PFSET2  NUMBER OF NONZERO ELEMENTS IN THE PARTITIONED HESSIAN
!         MATRIX.
!
! EXTERNAL SUBROUTINES :
!  SE  FUN  COMPUTATION 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  DFUN  COMPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION.
!         CALLING SEQUENCE: CALL DFUN(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 PSECU (NF, NA, MA, X, AF, IAG, JAG, IPAR, RPAR, F,
     &GMAX, ISPAS, IPRNT, ITERM)
      INTEGER NF,NA,MA,IAG(*),JAG(*),IPAR(7),ISPAS,IPRNT,ITERM
      DOUBLE PRECISION X(*),AF(*),RPAR(9),F,GMAX
      INTEGER NB,LGA,LG,LH,LHA,LAH,LS,LXO,LGO,LXS,LAG,LAGO,LIH,LJH,LIW,
     &MH,ML,IFIL,IER
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      INTEGER IA(:)
      DOUBLE PRECISION RA(:)
      ALLOCATABLE IA,RA
      IFIL=IPAR(7)
      IF (IFIL.LE.0) IFIL=1
      IF (ISPAS.LE.1) THEN
        CALL PASED3 (NF, NA, MA, IAG, JAG, IER)
        IF (IER.NE.0) THEN
          WRITE (6,'(''INPUT ERROR : IER = '',I3)') IER
          STOP
        END IF
      ELSE
        MA=IAG(NA+1)-1
      END IF
      CALL PFSET2 (NA, MH, ML, IAG)
      ALLOCATE(IA(2*NF+2+(IFIL+2)*MH))
      IF (IPAR(5).LE.2) THEN
        ALLOCATE(RA(6*NF+2*MA+(IFIL+3)*MH))
      ELSE
        ALLOCATE(RA(6*NF+ML+(IFIL+2)*MH))
      END IF
      NB=0
!
!     POINTERS FOR AUXILIARY ARRAYS
!
      LGA=1
      LG=LGA+NF
      LS=LG+NF
      LXO=LS+NF
      LGO=LXO+NF
      LXS=LGO+NF
      IF (IPAR(5).LE.2) THEN
        LHA=LXS
        LAG=LXS+NF
        LAGO=LAG+MA
        LAH=LAGO+MA
        LH=LAH+MH
      ELSE
        LAG=LXS
        LAGO=LXS
        LAH=LXS
        LHA=LXS+NF
        LH=LHA+ML
      END IF
      LIH=1
      LIW=LIH+NF+1
      LJH=LIW+NF+1
      CALL PSEC (NF, NA, NB, (IFIL+3)*MH, X, IA, RA, RA, AF, RA(LGA),
     &RA(LG), RA(LHA), RA(LAH), RA(LH), IA(LIH), IA(LJH), RA(LAG), IAG,
     &JAG, RA(LS), RA(LXO), RA(LGO), RA(LXS), RA(LAGO), IA(LIW), RPAR(1)
     &, RPAR(2), RPAR(3), RPAR(4), RPAR(5), RPAR(6), GMAX, F, IPAR(1),
     &IPAR(2), IPAR(3), IPAR(4), IPAR(5), IPAR(6), IPRNT, ITERM)
      DEALLOCATE(IA,RA)
      RETURN
      END
! SUBROUTINE PSECS              ALL SYSTEMS                   97/01/22
! PURPOSE :
! EASY TO USE SUBROUTINE FOR LARGE-SCALE BOX CONSTRAINED MINIMIZATION
! OF PARTIALLY SEPARABLE FUNCTIONS.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  II  NA  NUMBER OF APPROXIMATED FUNCTIONS.
!  IU  MA  NUMBER OF NONZERO ELEMENTS IN THE JACOBIAN MATRIX.
!  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-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  AF(NA)  VECTOR CONTAINING VALUES OF THE APPROXIMATED
!         FUNCTIONS.
!  RI  IAG(NA+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE JACOBIAN
!         MATRIX.
!  RI  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE JACOBIAN MATRIX.
!  II  IPAR(7)  INTEGER PAREMETERS:
!      IPAR(1)  MAXIMUM NUMBER OF ITERATIONS.
!      IPAR(2)  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!      IPAR(3)  MAXIMUM NUMBER OF GRADIENT EVALUATIONS.
!      IPAR(4)  ESTIMATION INDICATOR. IPAR(4)=0-MINIMUM IS NOT
!         ESTIMATED. IPAR(4)=1-MINIMUM IS ESTIMATED BY THE VALUE
!         RPAR(6).
!      IPAR(5)  TYPE OF VARIABLE METRIC UPDATE. IPAR(5)=1-THE BFGS
!         UPDATE. IPAR(5)=2-A COMBINATION OF THE BFGS AND THE RANK-ONE
!         UPDATES. IPAR(5)=3-THE DISCRETE NEWTON METHOD.
!      IPAR(6)  TYPE OF PRECONDITIONING. IPAR(6)=1-PRECONDITIONING IS
!         NOT USED. IPAR(6)=2-PRECONDITIONING BY THE INCOMPLETE
!         GILL-MURRAY DECOMPOSITION. IPAR(6)=3-PRECONDITIONING BY THE
!         INCOMPLETE GILL-MURRAY DECOMPOSITION WITH A PRELIMINARY
!         SOLUTION OF THE PRECONDITIONED SYSTEM WHICH IS USED IF IT
!         SATISFIES THE TERMINATION CRITERION.
!      IPAR(7)  NUMBER DEFINING THE SPACE FOR FILL-IN (THE SIZE OF THIS
!         SPACE IS IFIL TIMES THE STANDARD SIZE). THE DEFAULT VALUE IS
!         IFIL=1. THE DEFAULT VALUE HAS TO BE INCREASED IF ITERM IS
!         LESS OR EQUAL TO -40.
!  RI  RPAR(9)  REAL PARAMETERS:
!      RPAR(1)  MAXIMUM STEPSIZE.
!      RPAR(2)  TOLERANCE FOR THE CHANGE OF VARIABLES.
!      RPAR(3)  TOLERANCE FOR THE CHANGE OF FUNCTION VALUES.
!      RPAR(4)  TOLERANCE FOR THE FUNCTION FALUE.
!      RPAR(5)  TOLERANCE FOR THE GRADIENT NORM.
!      RPAR(6)  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!      RPAR(7)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PSEC.
!      RPAR(8)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PSEC.
!      RPAR(9)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PSEC.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  II  ISPAS  INPUT SPARSE STRUCTURE. ISPAS=1-STANDARD COORDINATE
!         FORM. ISPAS=2-SPARSE STRUCTURE COMPRESSED BY ROWS.
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!         VALUES ITERM<=-40 DETECT A LACK OF SPACE. IN THIS CASE,
!         PARAMETER IPAR(7) HAS TO BE INCREASED.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PSEC  VARIABLE METRIC METHOD FOR PARTIABLY SEPERABLE FUNCTIONS.
!  S   PASED3  COMPRESSED SPARSE STRUCTURE OF THE JACOBIAN MATRIX IS
!         COMPUTED FROM THE COORDINATE FORM.
!  S   PFSET2  NUMBER OF NONZERO ELEMENTS IN THE PARTITIONED HESSIAN
!         MATRIX.
!
! EXTERNAL SUBROUTINES :
!  SE  FUN  COMPUTATION 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  DFUN  COMPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION.
!         CALLING SEQUENCE: CALL DFUN(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 PSECS (NF, NA, MA, X, IX, XL, XU, AF, IAG, JAG, IPAR,
     &RPAR, F, GMAX, ISPAS, IPRNT, ITERM)
      INTEGER NF,NA,MA,IX(*),IAG(*),JAG(*),IPAR(7),ISPAS,IPRNT,ITERM
      DOUBLE PRECISION X(*),XL(*),XU(*),AF(*),RPAR(9),F,GMAX
      INTEGER NB,LGA,LG,LH,LHA,LAH,LS,LXO,LGO,LXS,LAG,LAGO,LIH,LJH,LIW,
     &MH,ML,IFIL,IER
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      INTEGER IA(:)
      DOUBLE PRECISION RA(:)
      ALLOCATABLE IA,RA
      IFIL=IPAR(7)
      IF (IFIL.LE.0) IFIL=1
      IF (ISPAS.LE.1) THEN
        CALL PASED3 (NF, NA, MA, IAG, JAG, IER)
        IF (IER.NE.0) THEN
          WRITE (6,'(''INPUT ERROR : IER = '',I3)') IER
          STOP
        END IF
      ELSE
        MA=IAG(NA+1)-1
      END IF
      CALL PFSET2 (NA, MH, ML, IAG)
      ALLOCATE(IA(2*NF+2+(IFIL+2)*MH))
      IF (IPAR(5).LE.2) THEN
        ALLOCATE(RA(6*NF+2*MA+(IFIL+3)*MH))
      ELSE
        ALLOCATE(RA(6*NF+ML+(IFIL+2)*MH))
      END IF
      NB=1
!
!     POINTERS FOR AUXILIARY ARRAYS
!
      LGA=1
      LG=LGA+NF
      LS=LG+NF
      LXO=LS+NF
      LGO=LXO+NF
      LXS=LGO+NF
      IF (IPAR(5).LE.2) THEN
        LHA=LXS
        LAG=LXS+NF
        LAGO=LAG+MA
        LAH=LAGO+MA
        LH=LAH+MH
      ELSE
        LAG=LXS
        LAGO=LXS
        LAH=LXS
        LHA=LXS+NF
        LH=LHA+ML
      END IF
      LIH=1
      LIW=LIH+NF+1
      LJH=LIW+NF+1
      CALL PSEC (NF, NA, NB, (IFIL+3)*MH, X, IX, XL, XU, AF, RA(LGA),
     &RA(LG), RA(LHA), RA(LAH), RA(LH), IA(LIH), IA(LJH), RA(LAG), IAG,
     &JAG, RA(LS), RA(LXO), RA(LGO), RA(LXS), RA(LAGO), IA(LIW), RPAR(1)
     &, RPAR(2), RPAR(3), RPAR(4), RPAR(5), RPAR(6), GMAX, F, IPAR(1),
     &IPAR(2), IPAR(3), IPAR(4), IPAR(5), IPAR(6), IPRNT, ITERM)
      DEALLOCATE(IA,RA)
      RETURN
      END
! SUBROUTINE PSEC               ALL SYSTEMS                   01/09/22
! PURPOSE :
! GENERAL SUBROUTINE FOR LARGE-SCALE BOX CONSTRAINED MINIMIZATION
! OF PARTIALLY SEPARABLE FUNCTIONS.
!
! 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  MMAX  MAXIMUM DIMENSION OF THE SPARSE TABLEAU.
!  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-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.
!  RI  AF(NA)  VECTOR CONTAINING VALUES OF THE APPROXIMATED
!         FUNCTIONS.
!  RA  GA(NF)  GRADIENT OF THE SELECTED APPROXIMATED FUNCTION.
!  RO  G(NF)  GRADIENT OF THE OBJECTIVE FUNCTION.
!  RA  HA(ML)  HESSIAN MATRIX OF THE SELECTED APPROXIMATING FUNCTION.
!  RA  AH(MH)  ELEMENTS OF THE PARTITIONED HESSIAN MATRIX.
!  RA  H(MMAX)  NONZERO ELEMENTS OF THE SPARSE HESSIAN MATRIX
!         TOGETHER WITH AN ADDITIONAL SPACE USED FOR THE NUMERICAL
!         DIFFERENTIATION.
!  II  IH(NF+1)  POINTERS OF DIAGONAL ELEMENTS OF THE MATRIX H.
!  IU  JH(MMAX)  INDICES OF NONZERO ELEMENTS OF THE MATRIX H
!         TOGETHER WITH AN ADDITIONAL SPACE USED FOR THE NUMERICAL
!         DIFFERENTIATION.
!  RA  AG(MA)  JACOBIAN MATRIX OF THE PARTITIONED FUNCTION.
!  RI  IAG(NA+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
!  RI  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
!  RO  S(NF)  DIRECTION VECTOR.
!  RU  XO(NF)  VECTORS OF VARIABLES DIFFERENCE.
!  RI  GO(NF)  GRADIENTS DIFFERENCE.
!  RA  XS(NF)  AUXILIARY VECTOR.
!  RA  AGO(MA)  OLD JACOBIAN MATRIX OF THE PARTITIONED FUNCTION,
!  IA  IW(NF+1)  AUXILIARY VECTOR.
!  RI  XMAX  MAXIMUM STEPSIZE.
!  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 NORM.
!  RI  FMIN  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  II  MIT  MAXIMUM NUMBER OF ITERATIONS.
!  II  MFV  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!  II  MFG  MAXIMUM NUMBER OF GRADIENT EVALUATIONS.
!  II  IEST  ESTIMATION INDICATOR. IEST=0-MINIMUM IS NOT ESTIMATED.
!         IEST=1-MINIMUM IS ESTIMATED BY THE VALUE FMIN.
!  II  MET  TYPE OF VARIABLE METRIC UPDATE. MET=1-THE BFGS UPDATE.
!         MET=2-A COMBINATION OF THE BFGS AND THE RANK-ONE UPDATES.
!         MET=3-THE DISCRETE NEWTON METHOD.
!  II  MOS2  TYPE OF PRECONDITIONING. MOS2=1-PRECONDITIONING IS NOT
!         USED. MOS2=2-PRECONDITIONING BY THE INCOMPLETE GILL-MURRAY
!         DECOMPOSITION. MOS2=3-PRECONDITIONING BY THE INCOMPLETE
!         GILL-MURRAY DECOMPOSITION WITH A PRELIMINARY SOLUTION OF
!         THE PRECONDITIONED SYSTEM WHICH IS USED IF IT SATISFIES
!         THE TERMINATION CRITERION.
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!         VALUES ITERM<=-40 DETECT A LACK OF SPACE.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PA1SF3  COMPUTATION OF THE VALUE AND THE GRADIENT OF A
!         PARTIALLY SEPARABLE OBJECTIVE FUNCTION.
!  S   PA2SF4 COMPUTATION OF THE VALUE, GRADIENT AND THE HESSIAN
!         MATRIX OF A PARTIALLY SEPARABLE OBJECTIVE FUNCTION.
!  S   PCBS04  ELIMINATION OF BOX CONSTRAINT VIOLATIONS.
!  S   PDSLM3  DIRECTION DETERMINATION USING THE CONJUGATE GRADIENT
!         ITERATIVE METHOD.
!  S   PFSET3  PREPARATION OF THE SPARSE HESSIAN MATRIX
!  S   PFSET4  PREPARATION OF THE PARTITIONED HESSIAN MATRIX
!  S   PS1L01  STEPSIZE SELECTION USING LINE SEARCH.
!  S   PUBBM1  VARIABLE METRIC UPDATE OF THE PARTITIONED HESSIAN MATRIX.
!  S   PYADC0  ADDITION OF A BOX CONSTRAINT.
!  S   PYFUT1  TEST ON TERMINATION.
!  S   PYRMC0  DELETION OF A BOX CONSTRAINT.
!  S   PYTRCD  COMPUTATION OF PROJECTED DIFFERENCES FOR THE VARIABLE MET
!         UPDATE.
!  S   PYTRCG  COMPUTATION OF THE PROJECTED GRADIENT.
!  S   PYTRCS  COMPUTATION OF THE PROJECTED DIRECTION VECTOR.
!  S   PYTSCH  CORRECTION OF THE HESSIAN MATRIX.
!  S   MXBSMI  INITIATION OF THE PARTITIONED HESSIAN MATRIX.
!  S   MXSSMI  SPARSE SYMMETRIC MATRIX IS REPLACED BY THE UNIT MATRIX.
!  S   MXUDIR  VECTOR AUGMENTED BY THE SCALED VECTOR.
!  S   MXUDOT  DOT PRODUCT OF TWO VECTORS.
!  S   MXVCOP  COPYING OF A VECTOR.
!  S   MXVDIF  DIFFERENCE OF TWO VECTORS.
!  S   MXVINB  PROJECTION OF A SPARSE SYMMETRIC MATRIX TO SATISFY BOX
!         CONSTRAINTS.
!  S   MXVINE  RESTORATION OF A SPARSE SYMMETRIC MATRIX OBTAINED BY
!         MXVINB
!  S   MXVINS  INITIATION OF THE INTEGER VECTOR.
!  S   MXVSAV  DIFFERENCE OF TWO VECTORS WITH COPYING AND SAVING THE
!         SUBSTRACTED ONE.
!  S   MXVSET  INITIATINON OF A VECTOR.
!
! EXTERNAL SUBROUTINES :
!  SE  FUN  COMPUTATION 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  DFUN  COMPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION.
!         CALLING SEQUENCE: CALL DFUN(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 :
! VARIABLE METRIC METHOD FOR MINIMIZATION OF LARGE-SCALE PARTIALLY
! SEPARABLE FUNCTIONS.
!
      SUBROUTINE PSEC (NF, NA, NB, MMAX, X, IX, XL, XU, AF, GA, G, HA,
     &AH, H, IH, JH, AG, IAG, JAG, S, XO, GO, XS, AGO, IW, XMAX, TOLX,
     &TOLF, TOLB, TOLG, FMIN, GMAX, F, MIT, MFV, MFG, IEST, MET, MOS2,
     &IPRNT, ITERM)
      INTEGER NF,NA,NB,MMAX,IX(*),IH(*),JH(*),IAG(*),JAG(*),IW(*),MIT,
     &MFV,MFG,IEST,MET,MOS2,IPRNT,ITERM
      DOUBLE PRECISION X(*),XL(*),XU(*),AF(*),AG(*),GA(*),G(*),HA(*),
     &AH(*),H(*),S(*),XO(*),GO(*),XS(*),AGO(*),TOLX,TOLF,TOLG,TOLB,FMIN,
     &XMAX,GMAX,UMAX,F
      INTEGER IDECF,ITERD,ITERS,ITERH,KD,LD,NTESX,NTESF,MTESX,MTESF,
     &MRED,KIT,IREST,KBF,MET1,MES,MES1,MES2,MES3,MAXST,ISYS,ITES,INITS,
     &KTERS,IRES1,IRES2,NRED,INEW,IOLD,I,M,MA,N,ICOR,ISNA
      DOUBLE PRECISION R,RO,RP,FO,FP,P,PO,PP,GNORM,SNORM,RMIN,RMAX,FMAX,
     &DMAX,ETA0,ETA2,ETA9,EPS8,EPS9,ALF1,ALF2,PAR1,PAR2,TOLD,TOLS,TOLP
      DOUBLE PRECISION MXUDOT
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      IF (ABS(IPRNT).GT.1) WRITE (6,'(1X,''ENTRY TO PSEC :'')')
!
!     INITIATION
!
      KBF=0
      IF (NB.GT.0) KBF=2
      NRES=0
      NDEC=0
      NIN=0
      NIT=0
      NFV=0
      NFG=0
      NFH=0
      ISYS=0
      ITES=1
      NTESX=0
      NTESF=0
      MTESX=2
      MTESF=2
      INITS=2
      ITERM=0
      ITERD=0
      ITERS=2
      ITERH=0
      KTERS=3
      IREST=0
      IRES1=999
      IRES2=0
      IDECF=0
      MRED=10
      MET1=1
      MES=4
      MES1=2
      MES2=2
      MES3=2
      ETA0=1.0D-15
      ETA2=1.0D-18
      ETA9=1.0D120
      EPS8=1.00D0
      EPS9=1.00D-8
      ALF1=1.0D-10
      ALF2=1.0D10
      RMAX=ETA9
      DMAX=ETA9
      FMAX=1.0D20
      IF (IEST.LE.0) FMIN=-1.0D60
      IF (IEST.GT.0) IEST=1
      IF (XMAX.LE.0.0D0) XMAX=1.0D16
      IF (TOLX.LE.0.0D0) TOLX=1.0D-16
      IF (TOLF.LE.0.0D0) TOLF=1.0D-14
      IF (TOLG.LE.0.0D0) TOLG=1.0D-6
      IF (TOLB.LE.0.0D0) TOLB=FMIN+1.0D-16
      TOLD=1.0D-4
      TOLS=1.0D-4
      TOLP=0.9D0
      IF (MIT.LE.0) MIT=9000
      IF (MFV.LE.0) MFV=9000
      IF (MFG.LE.0) MFG=9000
      IF (MET.LE.0) MET=2
      IF (MET.LE.2) MFG=MFV
      IF (MOS2.LE.0) MOS2=2
      KD=MAX(1,MET-1)
      LD=-1
      ISNA=3-KD
      KIT=-(IRES1*NF+IRES2)
      FO=FMIN
!
!     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
   10   CONTINUE
      END IF
      MA=IAG(NA+1)-1
      CALL MXVINP (NF+1, IH)
      CALL MXVINP (NF, JH)
      CALL PFSET3 (NF, NA, M, MMAX, IH, JH, IAG, JAG, ITERM)
      IF (ITERM.NE.0) GO TO 70
      ICOR=0
      IF (KBF.GT.0) THEN
        CALL PCBS04 (NF, X, IX, XL, XU, EPS9, KBF)
        CALL PYADC0 (NF, N, X, IX, XL, XU, INEW)
        CALL MXVINE (IH(NF+1)-1, JH)
      END IF
      IF (ITERM.NE.0) GO TO 70
      IF (MET.LE.2) THEN
        CALL PA1SF3 (NF, NA, X, GA, G, AG, IAG, JAG, F, AF, KD, LD,
     &   ISNA, NFV, NFG)
      ELSE
        CALL PA2SF4 (NF, NA, X, IX, GA, G, GO, HA, H, IH, JH, IAG, JAG,
     &   AF, F, ETA0, KBF, KD, LD, NFV, NFG, IDECF)
      END IF
!
!     START OF THE ITERATION WITH TESTS FOR TERMINATION.
!
   20 CALL PYTRCG (NF, NF, IX, G, UMAX, GMAX, KBF, IOLD)
      IF (ABS(IPRNT).GT.1) WRITE (6,'(1X,''NIT='',I5,2X,''NFV='',I5,2X,'
     &'NFG='',I5,2X,       ''F='', G16.9,2X,''G='',E10.3)') NIT,NFV,NFG,
     &F,GMAX
      CALL PYFUT1 (NF, F, FO, UMAX, GMAX, DMAX, TOLX, TOLF, TOLB, TOLG,
     &KD, NIT, KIT, MIT, NFV, MFV, NFG, MFG, NTESX, MTESX, NTESF, MTESF,
     & ITES, IRES1, IRES2, IREST, ITERS, ITERM)
      IF (ITERM.NE.0) GO TO 70
      IF (KBF.GT.0) CALL PYRMC0 (NF, N, IX, G, EPS8, UMAX, GMAX, RMAX,
     &IOLD, IREST)
   30 IF (IREST.GT.0) THEN
        IF (MET.LE.2) THEN
          CALL MXBSMI (NA, AH, IAG)
        ELSE
          CALL MXSSMI (NF, H, IH)
        END IF
        IDECF=0
        LD=MIN(LD,1)
        IF (KIT.LT.NIT) THEN
          NRES=NRES+1
          KIT=NIT
        ELSE
          ITERM=-10
          IF (ITERS.LT.0) ITERM=ITERS-5
          IF (GMAX.LE.1.0D2*TOLG) ITERM=-ITERM
        END IF
      END IF
      IF (ITERM.NE.0) GO TO 70
      IF (KBF.GT.0) THEN
        CALL MXVINB (M, IX, JH)
        CALL MXVINB (MA, IX, JAG)
      END IF
      IF (ITERS.NE.0) THEN
        IF (MET.LE.2) THEN
          CALL MXVSET (IH(NF+1)-1, 0.0D0, H)
          CALL PFSET4 (NA, H, IH, JH, AH, IAG, JAG)
        END IF
      END IF
      IF (KBF.GT.0) CALL PYTSCH (NF, IX, H, IH, JH, KBF)
!
!     DIRECTION DETERMINATION
!
      CALL PDSLM3 (NF, M, MMAX, IX, G, H, IH, JH, S, XO, GO, XS, IW,
     &GNORM, SNORM, ETA2, ETA9, KBF, MOS2, IDECF, NDEC, NIT, NIN, ITERD,
     & ITERM)
!
!     TEST ON DESCENT DIRECTION AND PREPARATION OF LINE SEARCH
!
      IF (KD.GT.0) P=MXUDOT(NF,G,S,IX,KBF)
      IF (ITERD.LT.0) THEN
        ITERM=ITERD
      ELSE
!
!     TEST ON DESCENT DIRECTION
!
        IF (SNORM.LE.0.0D0) THEN
          IREST=MAX(IREST,1)
        ELSE IF (P+TOLD*GNORM*SNORM.LE.0.0D0) THEN
          IREST=0
        ELSE
!
!     UNIFORM DESCENT CRITERION
!
          IREST=MAX(IREST,1)
        END IF
        IF (IREST.EQ.0) THEN
!
!     PREPARATION OF LINE SEARCH
!
          NRED=0
          RMIN=ALF1*GNORM/SNORM
          RMAX=MIN(ALF2*GNORM/SNORM,XMAX/SNORM)
        END IF
      END IF
      IF (ITERM.NE.0) GO TO 70
      IF (IREST.NE.0) GO TO 30
      IF (NIT.EQ.1) KIT=NIT
      CALL PYTRCS (NF, X, IX, XO, XL, XU, G, GO, S, RO, FP, FO, F, PO,
     &P, RMAX, ETA9, KBF)
      IF (RMAX.EQ.0.0D0) GO TO 60
      IF (MET.LE.2) CALL MXVCOP (MA, AG, AGO)
   40 CALL PS1L01 (R, RP, F, FO, FP, P, PO, PP, FMIN, FMAX, RMIN, RMAX,
     &TOLS, TOLP, PAR1, PAR2, KD, LD, NIT, KIT, NRED, MRED, MAXST, IEST,
     & INITS, ITERS, KTERS, MES, ISYS)
      IF (ISYS.EQ.0) GO TO 50
      CALL MXUDIR (NF, R, S, XO, X, IX, KBF)
      CALL PCBS04 (NF, X, IX, XL, XU, EPS9, KBF)
      IF (MET.LE.2) THEN
        CALL PA1SF3 (NF, NA, X, GA, G, AG, IAG, JAG, F, AF, KD, LD,
     &   ISNA, NFV, NFG)
      ELSE
        CALL PA2SF4 (NF, NA, X, IX, GA, G, GO, HA, H, IH, JH, IAG, JAG,
     &   AF, F, ETA0, KBF, KD, LD, NFV, NFG, IDECF)
      END IF
      P=MXUDOT(NF,G,S,IX,KBF)
      GO TO 40
   50 CONTINUE
      IF (ITERS.LE.0) THEN
        R=0.0D0
        F=FO
        P=PO
        CALL MXVCOP (NF, XO, X)
        CALL MXVCOP (NF, GO, G)
        IF (MET.LE.2) CALL MXVCOP (MA, AGO, AG)
        IREST=MAX(IREST,1)
        LD=KD
        GO TO 30
      END IF
      KD=MAX(1,MET-1)
      IF (KD.GT.LD) THEN
        IF (MET.LE.2) THEN
          CALL PA1SF3 (NF, NA, X, GA, G, AG, IAG, JAG, F, AF, KD, LD,
     &     ISNA, NFV, NFG)
        ELSE
          CALL PA2SF4 (NF, NA, X, IX, GA, G, GO, HA, H, IH, JH, IAG,
     &     JAG, AF, F, ETA0, KBF, KD, LD, NFV, NFG, IDECF)
        END IF
      END IF
      CALL PYTRCD (NF, X, IX, XO, G, GO, R, F, FO, P, PO, DMAX, KBF, KD,
     & LD, ITERS)
      IF (MET.LE.2) THEN
        IF (ITERS.GT.0) THEN
          CALL MXVDIF (MA, AG, AGO, AGO)
        ELSE
          CALL MXVSAV (MA, AG, AGO)
        END IF
        IDECF=0
        CALL PUBBM1 (NA, AH, IAG, JAG, S, XO, AGO, ETA0, ETA9, ICOR,
     &   NIT, KIT, ITERH, MET, MET1)
      END IF
   60 CONTINUE
      IF (ITERH.NE.0) IREST=MAX(IREST,1)
      IF (KBF.GT.0) CALL PYADC0 (NF, N, X, IX, XL, XU, INEW)
      GO TO 20
   70 CONTINUE
      IF (IPRNT.GT.1.OR.IPRNT.LT.0) WRITE (6,'(1X,''EXIT FROM PSEC :'')'
     &)
      IF (IPRNT.NE.0) WRITE (6,'(1X,''NIT='',I5,2X,''NFV='',I5,2X,''NFG=
     &'',I5,2X,       ''F='', G16.9,2X,''G='',E10.3,2X,''ITERM='',I3)')
     &NIT,NFV,NFG,F,GMAX,ITERM
      IF (IPRNT.LT.0) WRITE (6,'(1X,''X='',5(G14.7,1X):/(3X,5(G14.7,1X))
     &)') (X(I),I=1,NF)
      RETURN
      END
! SUBROUTINE PSEDU              ALL SYSTEMS                   97/01/22
! PURPOSE :
! EASY TO USE SUBROUTINE FOR LARGE-SCALE UNCONSTRAINED MINIMIZATION
! OF PARTIALLY SEPARABLE FUNCTIONS.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  II  NA  NUMBER OF APPROXIMATED FUNCTIONS.
!  IU  MA  NUMBER OF NONZERO ELEMENTS IN THE JACOBIAN MATRIX.
!  RI  X(NF)  VECTOR OF VARIABLES.
!  RO  AF(NA)  VECTOR CONTAINING VALUES OF THE APPROXIMATED
!         FUNCTIONS.
!  RI  IAG(NA+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE JACOBIAN
!         MATRIX.
!  RI  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE JACOBIAN MATRIX.
!  II  IPAR(7)  INTEGER PAREMETERS:
!      IPAR(1)  MAXIMUM NUMBER OF ITERATIONS.
!      IPAR(2)  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!      IPAR(3)  MAXIMUM NUMBER OF GRADIENT EVALUATIONS.
!      IPAR(4)  ESTIMATION INDICATOR. IPAR(4)=0-MINIMUM IS NOT
!         ESTIMATED. IPAR(4)=1-MINIMUM IS ESTIMATED BY THE VALUE
!         RPAR(6).
!      IPAR(5)  TYPE OF VARIABLE METRIC UPDATE. IPAR(5)=1-THE BFGS
!         UPDATE. IPAR(5)=2-A COMBINATION OF THE BFGS AND THE RANK-ONE
!         UPDATES. IPAR(5)=3-THE DISCRETE NEWTON METHOD.
!      IPAR(6)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PSED.
!      IPAR(7)  NUMBER DEFINING THE SPACE FOR FILL-IN (THE SIZE OF THIS
!         SPACE IS IFIL TIMES THE STANDARD SIZE). THE DEFAULT VALUE IS
!         IFIL=1. THE DEFAULT VALUE HAS TO BE INCREASED IF ITERM IS
!         LESS OR EQUAL TO -40.
!  RI  RPAR(9)  REAL PARAMETERS:
!      RPAR(1)  MAXIMUM STEPSIZE.
!      RPAR(2)  TOLERANCE FOR THE CHANGE OF VARIABLES.
!      RPAR(3)  TOLERANCE FOR THE CHANGE OF FUNCTION VALUES.
!      RPAR(4)  TOLERANCE FOR THE FUNCTION FALUE.
!      RPAR(5)  TOLERANCE FOR THE GRADIENT NORM.
!      RPAR(6)  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!      RPAR(7)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PSED.
!      RPAR(8)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PSED.
!      RPAR(9)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PSED.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  II  ISPAS  INPUT SPARSE STRUCTURE. ISPAS=1-STANDARD COORDINATE
!         FORM. ISPAS=2-SPARSE STRUCTURE COMPRESSED BY ROWS.
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!         VALUES ITERM<=-40 DETECT A LACK OF SPACE. IN THIS CASE,
!         PARAMETER IPAR(7) HAS TO BE INCREASED.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PSED  VARIABLE METRIC METHOD FOR PARTIABLY SEPERABLE FUNCTIONS.
!  S   PASED3  COMPRESSED SPARSE STRUCTURE OF THE JACOBIAN MATRIX IS
!         COMPUTED FROM THE COORDINATE FORM.
!  S   PFSET2  NUMBER OF NONZERO ELEMENTS IN THE PARTITIONED HESSIAN
!         MATRIX.
!
! EXTERNAL SUBROUTINES :
!  SE  FUN  COMPUTATION 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  DFUN  COMPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION.
!         CALLING SEQUENCE: CALL DFUN(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 PSEDU (NF, NA, MA, X, AF, IAG, JAG, IPAR, RPAR, F,
     &GMAX, ISPAS, IPRNT, ITERM)
      INTEGER NF,NA,MA,IAG(*),JAG(*),IPAR(7),ISPAS,IPRNT,ITERM
      DOUBLE PRECISION X(*),AF(*),RPAR(9),F,GMAX
      INTEGER NB,LGA,LG,LH,LHA,LAH,LS,LXO,LGO,LAG,LAGO,LIH,LJH,LPSL,
     &LPERM,LINVP,LWN11,LWN12,LWN13,LWN14,MH,ML,IFIL,IER
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      INTEGER IA(:)
      DOUBLE PRECISION RA(:)
      ALLOCATABLE IA,RA
      IFIL=IPAR(7)
      IF (IFIL.LE.0) IFIL=1
      IF (ISPAS.LE.1) THEN
        CALL PASED3 (NF, NA, MA, IAG, JAG, IER)
        IF (IER.NE.0) THEN
          WRITE (6,'(''INPUT ERROR : IER = '',I3)') IER
          STOP
        END IF
      ELSE
        MA=IAG(NA+1)-1
      END IF
      CALL PFSET2 (NA, MH, ML, IAG)
      ALLOCATE(IA(8*NF+6+(IFIL+3)*MH))
      IF (IPAR(5).LE.2) THEN
        ALLOCATE(RA(5*NF+2*MA+(IFIL+4)*MH))
      ELSE
        ALLOCATE(RA(5*NF+ML+(IFIL+3)*MH))
      END IF
      NB=0
!
!     POINTERS FOR AUXILIARY ARRAYS
!
      LGA=1
      LG=LGA+NF
      LS=LG+NF
      LXO=LS+NF
      LGO=LXO+NF
      IF (IPAR(5).LE.2) THEN
        LHA=LGO
        LAG=LGO+NF
        LAGO=LAG+MA
        LAH=LAGO+MA
        LH=LAH+MH
      ELSE
        LAG=LGO
        LAGO=LGO
        LAH=LGO
        LHA=LGO+NF
        LH=LHA+ML
      END IF
      LIH=1
      LPSL=LIH+NF+1
      LPERM=LPSL+NF+1
      LINVP=LPERM+NF
      LWN11=LINVP+NF
      LWN12=LWN11+NF+1
      LWN13=LWN12+NF+1
      LWN14=LWN13+NF+1
      LJH=LWN14+NF+1
      CALL PSED (NF, NA, NB, (IFIL+3)*MH, X, IA, RA, RA, AF, RA(LGA),
     &RA(LG), RA(LHA), RA(LAH), RA(LH), IA(LIH), IA(LJH), RA(LAG), IAG,
     &JAG, RA(LS), RA(LXO), RA(LGO), RA(LAGO), IA(LPSL), IA(LPERM),
     &IA(LINVP), IA(LWN11), IA(LWN12), IA(LWN13), IA(LWN14), RPAR(1),
     &RPAR(2), RPAR(3), RPAR(4), RPAR(5), RPAR(6), GMAX, F, IPAR(1),
     &IPAR(2), IPAR(3), IPAR(4), IPAR(5), IPRNT, ITERM)
      DEALLOCATE(IA,RA)
      RETURN
      END
! SUBROUTINE PSEDS              ALL SYSTEMS                   97/01/22
! PURPOSE :
! EASY TO USE SUBROUTINE FOR LARGE-SCALE BOX CONSTRAINED MINIMIZATION
! OF PARTIALLY SEPARABLE FUNCTIONS.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  II  NA  NUMBER OF APPROXIMATED FUNCTIONS.
!  IU  MA  NUMBER OF NONZERO ELEMENTS IN THE JACOBIAN MATRIX.
!  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-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  AF(NA)  VECTOR CONTAINING VALUES OF THE APPROXIMATED
!         FUNCTIONS.
!  RI  IAG(NA+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE JACOBIAN
!         MATRIX.
!  RI  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE JACOBIAN MATRIX.
!  II  IPAR(7)  INTEGER PAREMETERS:
!      IPAR(1)  MAXIMUM NUMBER OF ITERATIONS.
!      IPAR(2)  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!      IPAR(3)  MAXIMUM NUMBER OF GRADIENT EVALUATIONS.
!      IPAR(4)  ESTIMATION INDICATOR. IPAR(4)=0-MINIMUM IS NOT
!         ESTIMATED. IPAR(4)=1-MINIMUM IS ESTIMATED BY THE VALUE
!         RPAR(6).
!      IPAR(5)  TYPE OF VARIABLE METRIC UPDATE. IPAR(5)=1-THE BFGS
!         UPDATE. IPAR(5)=2-A COMBINATION OF THE BFGS AND THE RANK-ONE
!         UPDATES. IPAR(5)=3-THE DISCRETE NEWTON METHOD.
!      IPAR(6)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PSED.
!      IPAR(7)  NUMBER DEFINING THE SPACE FOR FILL-IN (THE SIZE OF THIS
!         SPACE IS IFIL TIMES THE STANDARD SIZE). THE DEFAULT VALUE IS
!         IFIL=1. THE DEFAULT VALUE HAS TO BE INCREASED IF ITERM IS
!         LESS OR EQUAL TO -40.
!  RI  RPAR(9)  REAL PARAMETERS:
!      RPAR(1)  MAXIMUM STEPSIZE.
!      RPAR(2)  TOLERANCE FOR THE CHANGE OF VARIABLES.
!      RPAR(3)  TOLERANCE FOR THE CHANGE OF FUNCTION VALUES.
!      RPAR(4)  TOLERANCE FOR THE FUNCTION FALUE.
!      RPAR(5)  TOLERANCE FOR THE GRADIENT NORM.
!      RPAR(6)  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!      RPAR(7)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PSED.
!      RPAR(8)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PSED.
!      RPAR(9)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PSED.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  II  ISPAS  INPUT SPARSE STRUCTURE. ISPAS=1-STANDARD COORDINATE
!         FORM. ISPAS=2-SPARSE STRUCTURE COMPRESSED BY ROWS.
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!         VALUES ITERM<=-40 DETECT A LACK OF SPACE. IN THIS CASE,
!         PARAMETER IPAR(7) HAS TO BE INCREASED.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PSED  VARIABLE METRIC METHOD FOR PARTIABLY SEPERABLE FUNCTIONS.
!  S   PASED3  COMPRESSED SPARSE STRUCTURE OF THE JACOBIAN MATRIX IS
!         COMPUTED FROM THE COORDINATE FORM.
!  S   PFSET2  NUMBER OF NONZERO ELEMENTS IN THE PARTITIONED HESSIAN
!         MATRIX.
!
! EXTERNAL SUBROUTINES :
!  SE  FUN  COMPUTATION 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  DFUN  COMPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION.
!         CALLING SEQUENCE: CALL DFUN(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 PSEDS (NF, NA, MA, X, IX, XL, XU, AF, IAG, JAG, IPAR,
     &RPAR, F, GMAX, ISPAS, IPRNT, ITERM)
      INTEGER NF,NA,MA,IX(*),IAG(*),JAG(*),IPAR(7),ISPAS,IPRNT,ITERM
      DOUBLE PRECISION X(*),XL(*),XU(*),AF(*),RPAR(9),F,GMAX
      INTEGER NB,LGA,LG,LH,LHA,LAH,LS,LXO,LGO,LAG,LAGO,LIH,LJH,LPSL,
     &LPERM,LINVP,LWN11,LWN12,LWN13,LWN14,MH,ML,IFIL,IER
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      INTEGER IA(:)
      DOUBLE PRECISION RA(:)
      ALLOCATABLE IA,RA
      IFIL=IPAR(7)
      IF (IFIL.LE.0) IFIL=1
      IF (ISPAS.LE.1) THEN
        CALL PASED3 (NF, NA, MA, IAG, JAG, IER)
        IF (IER.NE.0) THEN
          WRITE (6,'(''INPUT ERROR : IER = '',I3)') IER
          STOP
        END IF
      ELSE
        MA=IAG(NA+1)-1
      END IF
      CALL PFSET2 (NA, MH, ML, IAG)
      ALLOCATE(IA(8*NF+6+(IFIL+3)*MH))
      IF (IPAR(5).LE.2) THEN
        ALLOCATE(RA(5*NF+2*MA+(IFIL+4)*MH))
      ELSE
        ALLOCATE(RA(5*NF+ML+(IFIL+3)*MH))
      END IF
      NB=1
!
!     POINTERS FOR AUXILIARY ARRAYS
!
      LGA=1
      LG=LGA+NF
      LS=LG+NF
      LXO=LS+NF
      LGO=LXO+NF
      IF (IPAR(5).LE.2) THEN
        LHA=LGO
        LAG=LGO+NF
        LAGO=LAG+MA
        LAH=LAGO+MA
        LH=LAH+MH
      ELSE
        LAG=LGO
        LAGO=LGO
        LAH=LGO
        LHA=LGO+NF
        LH=LHA+ML
      END IF
      LIH=1
      LPSL=LIH+NF+1
      LPERM=LPSL+NF+1
      LINVP=LPERM+NF
      LWN11=LINVP+NF
      LWN12=LWN11+NF+1
      LWN13=LWN12+NF+1
      LWN14=LWN13+NF+1
      LJH=LWN14+NF+1
      CALL PSED (NF, NA, NB, (IFIL+3)*MH, X, IX, XL, XU, AF, RA(LGA),
     &RA(LG), RA(LHA), RA(LAH), RA(LH), IA(LIH), IA(LJH), RA(LAG), IAG,
     &JAG, RA(LS), RA(LXO), RA(LGO), RA(LAGO), IA(LPSL), IA(LPERM),
     &IA(LINVP), IA(LWN11), IA(LWN12), IA(LWN13), IA(LWN14), RPAR(1),
     &RPAR(2), RPAR(3), RPAR(4), RPAR(5), RPAR(6), GMAX, F, IPAR(1),
     &IPAR(2), IPAR(3), IPAR(4), IPAR(5), IPRNT, ITERM)
      DEALLOCATE(IA,RA)
      RETURN
      END
! SUBROUTINE PSED               ALL SYSTEMS                   01/09/22
! PURPOSE :
! GENERAL SUBROUTINE FOR LARGE-SCALE BOX CONSTRAINED MINIMIZATION
! OF PARTIALLY SEPARABLE FUNCTIONS.
!
! 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  MMAX  MAXIMUM DIMENSION OF THE SPARSE TABLEAU.
!  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-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.
!  RI  AF(NA)  VECTOR CONTAINING VALUES OF THE APPROXIMATED
!         FUNCTIONS.
!  RA  GA(NF)  GRADIENT OF THE SELECTED APPROXIMATED FUNCTION.
!  RO  G(NF)  GRADIENT OF THE OBJECTIVE FUNCTION.
!  RA  HA(ML)  HESSIAN MATRIX OF THE SELECTED APPROXIMATING FUNCTION.
!  RA  AH(MH)  ELEMENTS OF THE PARTITIONED HESSIAN MATRIX.
!  RA  H(MMAX)  NONZERO ELEMENTS OF THE SPARSE HESSIAN MATRIX
!         TOGETHER WITH AN ADDITIONAL SPACE USED FOR THE NUMERICAL
!         DIFFERENTIATION.
!  II  IH(NF+1)  POINTERS OF DIAGONAL ELEMENTS OF THE MATRIX H.
!  IU  JH(MMAX)  INDICES OF NONZERO ELEMENTS OF THE MATRIX H
!         TOGETHER WITH AN ADDITIONAL SPACE USED FOR THE NUMERICAL
!         DIFFERENTIATION.
!  RA  AG(MA)  JACOBIAN MATRIX OF THE PARTITIONED FUNCTION.
!  RI  IAG(NA+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
!  RI  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
!  RO  S(NF)  DIRECTION VECTOR.
!  RU  XO(NF)  VECTORS OF VARIABLES DIFFERENCE.
!  RI  GO(NF)  GRADIENTS DIFFERENCE.
!  RA  AGO(MA)  OLD JACOBIAN MATRIX OF THE PARTITIONED FUNCTION,
!  II  PSL(NF+1)  POINTER VECTOR OF THE COMPACT FORM OF THE TRIANGULAR
!         FACTOR OF THE HESSIAN APPROXIMATION.
!  IA  PERM(NF)  PERMUTATION VECTOR.
!  IA  INVP(NF)  INVERSE PERMUTATION VECTOR.
!  IA  WN11(NF+1) AUXILIARY VECTOR.
!  IA  WN12(NF+1) AUXILIARY VECTOR.
!  IA  WN13(NF+1) AUXILIARY VECTOR.
!  IA  WN14(NF+1) AUXILIARY VECTOR.
!  RI  XMAX  MAXIMUM STEPSIZE.
!  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 NORM.
!  RI  FMIN  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  II  MIT  MAXIMUM NUMBER OF ITERATIONS.
!  II  MFV  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!  II  MFG  MAXIMUM NUMBER OF GRADIENT EVALUATIONS.
!  II  IEST  ESTIMATION INDICATOR. IEST=0-MINIMUM IS NOT ESTIMATED.
!         IEST=1-MINIMUM IS ESTIMATED BY THE VALUE FMIN.
!  II  MET  TYPE OF VARIABLE METRIC UPDATE. MET=1-THE BFGS UPDATE.
!         MET=2-A COMBINATION OF THE BFGS AND THE RANK-ONE UPDATES.
!         MET=3-THE DISCRETE NEWTON METHOD.
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!         VALUES ITERM<=-40 DETECT A LACK OF SPACE.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PA1SF3  COMPUTATION OF THE VALUE AND THE GRADIENT OF A
!         PARTIALLY SEPARABLE OBJECTIVE FUNCTION.
!  S   PA2SF4 COMPUTATION OF THE VALUE, GRADIENT AND THE HESSIAN
!         MATRIX OF A PARTIALLY SEPARABLE OBJECTIVE FUNCTION.
!  S   PCBS04  ELIMINATION OF BOX CONSTRAINT VIOLATIONS.
!  S   PDSLM1  DIRECTION DETERMINATION USING THE GILL-MURRAY DIRECT
!         DECOMPOSITION METHOD.
!  S   PFSET3  PREPARATION OF THE SPARSE HESSIAN MATRIX
!  S   PFSET4  PREPARATION OF THE PARTITIONED HESSIAN MATRIX
!  S   PS1L01  STEPSIZE SELECTION USING LINE SEARCH.
!  S   PUBBM1  VARIABLE METRIC UPDATE OF THE PARTITIONED HESSIAN MATRIX.
!  S   PYADC0  ADDITION OF A BOX CONSTRAINT.
!  S   PYFUT1  TEST ON TERMINATION.
!  S   PYRMC0  DELETION OF A BOX CONSTRAINT.
!  S   PYTRCD  COMPUTATION OF PROJECTED DIFFERENCES FOR THE VARIABLE MET
!         UPDATE.
!  S   PYTRCG  COMPUTATION OF THE PROJECTED GRADIENT.
!  S   PYTRCS  COMPUTATION OF THE PROJECTED DIRECTION VECTOR.
!  S   PYTSCH  CORRECTION OF THE HESSIAN MATRIX.
!  S   MXBSMI  INITIATION OF THE PARTITIONED HESSIAN MATRIX.
!  S   MXSPCC  SPARSE MATRIX REORDERING, SYMBOLIC FACTORIZATION, DATA
!         STRUCTURES TRANSFORMATION. INITIATION OF THE DIRECT SPARSE
!         SOLVER.
!  S   MXSSMI  SPARSE SYMMETRIC MATRIX IS REPLACED BY THE UNIT MATRIX.
!  S   MXUDIR  VECTOR AUGMENTED BY THE SCALED VECTOR.
!  RF  MXUDOT  DOT PRODUCT OF TWO VECTORS.
!  S   MXVCOP  COPYING OF A VECTOR.
!  S   MXVDIF  DIFFERENCE OF TWO VECTORS.
!  S   MXVINB  PROJECTION OF A SPARSE SYMMETRIC MATRIX TO SATISFY BOX
!         CONSTRAINTS.
!  S   MXVINE  RESTORATION OF A SPARSE SYMMETRIC MATRIX OBTAINED BY
!         MXVINB
!  S   MXVINS  INITIATION OF THE INTEGER VECTOR.
!  S   MXVSAV  DIFFERENCE OF TWO VECTORS WITH COPYING AND SAVING THE
!         SUBSTRACTED ONE.
!  S   MXVSET  INITIATINON OF A VECTOR.
!
! EXTERNAL SUBROUTINES :
!  SE  FUN  COMPUTATION 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  DFUN  COMPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION.
!         CALLING SEQUENCE: CALL DFUN(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 :
! VARIABLE METRIC AND DISCRETE NEWTON METHODS FOR MINIMIZATION OF
! LARGE-SCALE PARTIALLY SEPARABLE FUNCTIONS.
!
      SUBROUTINE PSED (NF, NA, NB, MMAX, X, IX, XL, XU, AF, GA, G, HA,
     &AH, H, IH, JH, AG, IAG, JAG, S, XO, GO, AGO, PSL, PERM, INVP,
     &WN11, WN12, WN13, WN14, XMAX, TOLX, TOLF, TOLB, TOLG, FMIN, GMAX,
     &F, MIT, MFV, MFG, IEST, MET, IPRNT, ITERM)
      INTEGER NF,NA,NB,MMAX,IX(*),IH(*),JH(*),IAG(*),JAG(*),PSL(*),
     &PERM(*),INVP(*),WN11(*),WN12(*),WN13(*),WN14(*),IPRNT,MIT,MFV,MFG,
     &IEST,MET,ITERM
      DOUBLE PRECISION X(*),XL(*),XU(*),AF(*),AG(*),GA(*),G(*),HA(*),
     &AH(*),H(*),S(*),XO(*),GO(*),AGO(*),TOLX,TOLF,TOLG,TOLB,FMIN,XMAX,
     &GMAX,UMAX,F
      INTEGER IDECF,ITERD,ITERS,ITERH,KD,LD,NTESX,NTESF,MTESX,MTESF,
     &MRED,KIT,IREST,KBF,MET1,MES,MES1,MES2,MES3,MAXST,ISYS,ITES,INITS,
     &KTERS,IRES1,IRES2,NRED,INEW,IOLD,I,M,MA,MH,N,ICOR,ISNA
      DOUBLE PRECISION R,RO,RP,FO,FP,P,PO,PP,GNORM,SNORM,RMIN,RMAX,FMAX,
     &DMAX,ETA0,ETA2,ETA9,EPS8,EPS9,ALF1,ALF2,PAR1,PAR2,TOLD,TOLS,TOLP
      DOUBLE PRECISION MXUDOT
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      IF (ABS(IPRNT).GT.1) WRITE (6,'(1X,''ENTRY TO PSED :'')')
!
!     INITIATION
!
      KBF=0
      IF (NB.GT.0) KBF=2
      NRES=0
      NDEC=0
      NIN=0
      NIT=0
      NFV=0
      NFG=0
      NFH=0
      ISYS=0
      ITES=1
      NTESX=0
      NTESF=0
      MTESX=2
      MTESF=2
      INITS=2
      ITERM=0
      ITERD=0
      ITERS=2
      ITERH=0
      KTERS=3
      IREST=0
      IRES1=999
      IRES2=0
      IDECF=0
      MRED=10
      MET1=1
      MES=4
      MES1=2
      MES2=2
      MES3=2
      ETA0=1.0D-15
      ETA2=1.0D-18
      ETA9=1.0D120
      EPS8=1.00D0
      EPS9=1.00D-8
      ALF1=1.0D-10
      ALF2=1.0D10
      RMAX=ETA9
      DMAX=ETA9
      FMAX=1.0D20
      IF (IEST.LE.0) FMIN=-1.0D60
      IF (IEST.GT.0) IEST=1
      IF (XMAX.LE.0.0D0) XMAX=1.0D16
      IF (TOLX.LE.0.0D0) TOLX=1.0D-16
      IF (TOLF.LE.0.0D0) TOLF=1.0D-14
      IF (TOLG.LE.0.0D0) TOLG=1.0D-6
      IF (TOLB.LE.0.0D0) TOLB=FMIN+1.0D-16
      TOLD=1.0D-4
      TOLS=1.0D-4
      TOLP=0.9D0
      IF (MIT.LE.0) MIT=9000
      IF (MFV.LE.0) MFV=9000
      IF (MFG.LE.0) MFG=9000
      IF (MET.LE.0) MET=2
      IF (MET.LE.2) MFG=MFV
      KD=MAX(1,MET-1)
      LD=-1
      ISNA=3-KD
      KIT=-(IRES1*NF+IRES2)
      FO=FMIN
!
!     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
   10   CONTINUE
      END IF
      MA=IAG(NA+1)-1
      CALL MXVINP (NF+1, IH)
      CALL MXVINP (NF, JH)
      CALL PFSET3 (NF, NA, M, MMAX, IH, JH, IAG, JAG, ITERM)
      IF (ITERM.NE.0) GO TO 70
      ICOR=0
      IF (KBF.GT.0) THEN
        CALL PCBS04 (NF, X, IX, XL, XU, EPS9, KBF)
        CALL PYADC0 (NF, N, X, IX, XL, XU, INEW)
        CALL MXVINE (IH(NF+1)-1, JH)
      END IF
      MH=0
      CALL MXSPCC (NF, M, MH, MMAX, H, IH, JH, PSL, PERM, INVP, WN11,
     &WN12, WN13, WN14, ITERM)
      IF (ITERM.NE.0) GO TO 70
      IF (MET.LE.2) THEN
        CALL PA1SF3 (NF, NA, X, GA, G, AG, IAG, JAG, F, AF, KD, LD,
     &   ISNA, NFV, NFG)
      ELSE
        CALL PA2SF4 (NF, NA, X, IX, GA, G, GO, HA, H, IH, JH, IAG, JAG,
     &   AF, F, ETA0, KBF, KD, LD, NFV, NFG, IDECF)
      END IF
!
!     START OF THE ITERATION WITH TESTS FOR TERMINATION.
!
   20 CALL PYTRCG (NF, NF, IX, G, UMAX, GMAX, KBF, IOLD)
      IF (ABS(IPRNT).GT.1) WRITE (6,'(1X,''NIT='',I5,2X,''NFV='',I5,2X,'
     &'NFG='',I5,2X,       ''F='', G16.9,2X,''G='',E10.3)') NIT,NFV,NFG,
     &F,GMAX
      CALL PYFUT1 (NF, F, FO, UMAX, GMAX, DMAX, TOLX, TOLF, TOLB, TOLG,
     &KD, NIT, KIT, MIT, NFV, MFV, NFG, MFG, NTESX, MTESX, NTESF, MTESF,
     & ITES, IRES1, IRES2, IREST, ITERS, ITERM)
      IF (ITERM.NE.0) GO TO 70
      IF (KBF.GT.0) CALL PYRMC0 (NF, N, IX, G, EPS8, UMAX, GMAX, RMAX,
     &IOLD, IREST)
   30 IF (IREST.GT.0) THEN
        IF (MET.LE.2) THEN
          CALL MXBSMI (NA, AH, IAG)
        ELSE
          CALL MXSSMI (NF, H, IH)
        END IF
        IDECF=0
        LD=MIN(LD,1)
        IF (KIT.LT.NIT) THEN
          NRES=NRES+1
          KIT=NIT
        ELSE
          ITERM=-10
          IF (ITERS.LT.0) ITERM=ITERS-5
          IF (GMAX.LE.1.0D2*TOLG) ITERM=-ITERM
        END IF
      END IF
      IF (ITERM.NE.0) GO TO 70
      IF (KBF.GT.0) THEN
        CALL MXVINB (M, IX, JH)
        CALL MXVINB (MA, IX, JAG)
      END IF
      IF (ITERS.NE.0) THEN
        IF (MET.LE.2) THEN
          CALL MXVSET (IH(NF+1)-1, 0.0D0, H)
          CALL PFSET4 (NA, H, IH, JH, AH, IAG, JAG)
        END IF
      END IF
      IF (KBF.GT.0) CALL PYTSCH (NF, IX, H, IH, JH, KBF)
!
!     DIRECTION DETERMINATION
!
      CALL PDSLM1 (NF, MMAX, MH, IX, G, H, IH, JH, S, XO, PSL, PERM,
     &WN11, WN12, GNORM, SNORM, ETA2, KBF, IDECF, NDEC, ITERD, ITERM)
!
!     TEST ON DESCENT DIRECTION AND PREPARATION OF LINE SEARCH
!
      IF (KD.GT.0) P=MXUDOT(NF,G,S,IX,KBF)
      IF (ITERD.LT.0) THEN
        ITERM=ITERD
      ELSE
!
!     TEST ON DESCENT DIRECTION
!
        IF (SNORM.LE.0.0D0) THEN
          IREST=MAX(IREST,1)
        ELSE IF (P+TOLD*GNORM*SNORM.LE.0.0D0) THEN
          IREST=0
        ELSE
!
!     UNIFORM DESCENT CRITERION
!
          IREST=MAX(IREST,1)
        END IF
        IF (IREST.EQ.0) THEN
!
!     PREPARATION OF LINE SEARCH
!
          NRED=0
          RMIN=ALF1*GNORM/SNORM
          RMAX=MIN(ALF2*GNORM/SNORM,XMAX/SNORM)
        END IF
      END IF
      IF (ITERM.NE.0) GO TO 70
      IF (IREST.NE.0) GO TO 30
      IF (NIT.EQ.1) KIT=NIT
      CALL PYTRCS (NF, X, IX, XO, XL, XU, G, GO, S, RO, FP, FO, F, PO,
     &P, RMAX, ETA9, KBF)
      IF (RMAX.EQ.0.0D0) GO TO 60
      IF (MET.LE.2) CALL MXVCOP (MA, AG, AGO)
   40 CALL PS1L01 (R, RP, F, FO, FP, P, PO, PP, FMIN, FMAX, RMIN, RMAX,
     &TOLS, TOLP, PAR1, PAR2, KD, LD, NIT, KIT, NRED, MRED, MAXST, IEST,
     & INITS, ITERS, KTERS, MES, ISYS)
      IF (ISYS.EQ.0) GO TO 50
      CALL MXUDIR (NF, R, S, XO, X, IX, KBF)
      CALL PCBS04 (NF, X, IX, XL, XU, EPS9, KBF)
      IF (MET.LE.2) THEN
        CALL PA1SF3 (NF, NA, X, GA, G, AG, IAG, JAG, F, AF, KD, LD,
     &   ISNA, NFV, NFG)
      ELSE
        CALL PA2SF4 (NF, NA, X, IX, GA, G, GO, HA, H, IH, JH, IAG, JAG,
     &   AF, F, ETA0, KBF, KD, LD, NFV, NFG, IDECF)
      END IF
      P=MXUDOT(NF,G,S,IX,KBF)
      GO TO 40
   50 CONTINUE
      IF (ITERS.LE.0) THEN
        R=0.0D0
        F=FO
        P=PO
        CALL MXVCOP (NF, XO, X)
        CALL MXVCOP (NF, GO, G)
        IF (MET.LE.2) CALL MXVCOP (MA, AGO, AG)
        IREST=MAX(IREST,1)
        LD=KD
        GO TO 30
      END IF
      KD=MAX(1,MET-1)
      IF (KD.GT.LD) THEN
        IF (MET.LE.2) THEN
          CALL PA1SF3 (NF, NA, X, GA, G, AG, IAG, JAG, F, AF, KD, LD,
     &     ISNA, NFV, NFG)
        ELSE
          CALL PA2SF4 (NF, NA, X, IX, GA, G, GO, HA, H, IH, JH, IAG,
     &     JAG, AF, F, ETA0, KBF, KD, LD, NFV, NFG, IDECF)
        END IF
      END IF
      CALL PYTRCD (NF, X, IX, XO, G, GO, R, F, FO, P, PO, DMAX, KBF, KD,
     & LD, ITERS)
      IF (MET.LE.2) THEN
        IF (ITERS.GT.0) THEN
          CALL MXVDIF (MA, AG, AGO, AGO)
        ELSE
          CALL MXVSAV (MA, AG, AGO)
        END IF
        IDECF=0
        CALL PUBBM1 (NA, AH, IAG, JAG, S, XO, AGO, ETA0, ETA9, ICOR,
     &   NIT, KIT, ITERH, MET, MET1)
      END IF
   60 CONTINUE
      IF (ITERH.NE.0) IREST=MAX(IREST,1)
      IF (KBF.GT.0) CALL PYADC0 (NF, N, X, IX, XL, XU, INEW)
      GO TO 20
   70 CONTINUE
      IF (IPRNT.GT.1.OR.IPRNT.LT.0) WRITE (6,'(1X,''EXIT FROM PSED :'')'
     &)
      IF (IPRNT.NE.0) WRITE (6,'(1X,''NIT='',I5,2X,''NFV='',I5,2X,''NFG=
     &'',I5,2X,       ''F='', G16.9,2X,''G='',E10.3,2X,''ITERM='',I3)')
     &NIT,NFV,NFG,F,GMAX,ITERM
      IF (IPRNT.LT.0) WRITE (6,'(1X,''X='',5(G14.7,1X):/(3X,5(G14.7,1X))
     &)') (X(I),I=1,NF)
      RETURN
      END
! SUBROUTINE PSENU              ALL SYSTEMS                   97/01/22
! PURPOSE :
! EASY TO USE SUBROUTINE FOR LARGE-SCALE UNCONSTRAINED MINIMIZATION
! OF NONSMOOTH PARTIALLY SEPARABLE FUNCTIONS.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  II  NA  NUMBER OF PARTIAL FUNCTIONS.
!  IU  MA  NUMBER OF NONZERO ELEMENTS IN THE JACOBIAN MATRIX.
!  RI  X(NF)  VECTOR OF VARIABLES.
!  RO  AF(NA)  VECTOR CONTAINING VALUES OF THE APPROXIMATED
!         FUNCTIONS.
!  RI  IAG(NA+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE JACOBIAN
!         MATRIX.
!  RI  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE JACOBIAN MATRIX.
!  II  IPAR(7)  INTEGER PAREMETERS:
!      IPAR(1)  MAXIMUM NUMBER OF ITERATIONS.
!      IPAR(2)  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!      IPAR(3)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PMAX.
!      IPAR(4)  ESTIMATION INDICATOR. IPAR(4)=0-MINIMUM IS NOT
!         ESTIMATED. IPAR(4)=1-MINIMUM IS ESTIMATED BY THE VALUE
!         RPAR(6).
!      IPAR(5)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PSEN.
!      IPAR(6)  DIMENSION OF A BUNDLE USED IN THE LINE SEARCH.
!      IPAR(7)  NUMBER DEFINING THE SPACE FOR FILL-IN (THE SIZE OF THIS
!         SPACE IS IFIL TIMES THE STANDARD SIZE). THE DEFAULT VALUE IS
!         IFIL=1. THE DEFAULT VALUE HAS TO BE INCREASED IF ITERM IS
!         LESS OR EQUAL TO -40.
!  RI  RPAR(9)  REAL PARAMETERS:
!      RPAR(1)  MAXIMUM STEPSIZE.
!      RPAR(2)  TOLERANCE FOR THE CHANGE OF VARIABLES.
!      RPAR(3)  TOLERANCE FOR THE CHANGE OF FUNCTION VALUES.
!      RPAR(4)  TOLERANCE FOR THE FUNCTION FALUE.
!      RPAR(5)  TOLERANCE FOR THE GRADIENT NORM.
!      RPAR(6)  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!      RPAR(7)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PSEN.
!      RPAR(8)  CORRECTION PARAMETER.
!      RPAR(9)  PARAMETER FOR SUBGRADIENT LOCALITY MEASURE.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  II  ISPAS  INPUT SPARSE STRUCTURE. ISPAS=1-STANDARD COORDINATE
!         FORM. ISPAS=2-SPARSE STRUCTURE COMPRESSED BY ROWS.
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!         VALUES ITERM<=-40 DETECT A LACK OF SPACE. IN THIS CASE,
!         PARAMETER IPAR(7) HAS TO BE INCREASED.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PSEN  BUNDLE VARIABLE METRIC METHOD FOR NONSMOOTH PARTIALLY
!         SEPARABLE FUNCTION.
!  S   PASED3  COMPRESSED SPARSE STRUCTURE OF THE JACOBIAN MATRIX IS
!         COMPUTED FROM THE COORDINATE FORM.
!  S   PFSET2  NUMBER OF NONZERO ELEMENTS IN THE PARTITIONED HESSIAN
!         MATRIX.
!
! EXTERNAL SUBROUTINES :
!  SE  FUN  COMPUTATION OF THE VALUE OF THE PARTIAL 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  DFUN  COMPUTATION OF THE SUBGRADIENT OF THE PARTIAL FUNCTION.
!         CALLING SEQUENCE: CALL DFUN(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 SUBGRADIENT
!         OF THE APPROXIMATED FUNCTION.
!
      SUBROUTINE PSENU (NF, NA, MA, X, AF, IAG, JAG, IPAR, RPAR, F,
     &GMAX, ISPAS, IPRNT, ITERM)
      INTEGER NF,NA,MA,IAG(*),JAG(*),IPAR(7),ISPAS,IPRNT,ITERM
      DOUBLE PRECISION X(*),AF(*),RPAR(9),F,GMAX
      INTEGER LAG,LAGO,LAH,LGA,LG,LH,LS,LXO,LGO,LXS,LGS,LGP,LIH,LJH,LAX,
     &LAY,LAZ,LPSL,LPERM,LINVP,LWN11,LWN12,LWN13,LWN14,MB,MC,MH,IFIL,
     &IER
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      INTEGER IA(:)
      DOUBLE PRECISION RA(:)
      ALLOCATABLE IA,RA
      MB=IPAR(6)
      IF (MB.LE.0) MB=20
      IFIL=IPAR(7)
      IF (IFIL.LE.0) IFIL=1
      IF (ISPAS.LE.1) THEN
        CALL PASED3 (NF, NA, MA, IAG, JAG, IER)
        IF (IER.NE.0) THEN
          WRITE (6,'(''INPUT ERROR : IER = '',I3)') IER
          STOP
        END IF
      ELSE
        MA=IAG(NA+1)-1
      END IF
      CALL PFSET2 (NA, MH, MC, IAG)
      ALLOCATE(IA(8*NF+6+(IFIL+3)*MH),RA(2*MA+8*NF+2*(NF+2)*MB+(IFIL+4)*
     &MH))
!
!     POINTERS FOR AUXILIARY ARRAYS
!
      LAG=1
      LAGO=LAG+MA
      LAH=LAGO+MA
      LGA=LAH+MH
      LG=LGA+NF
      LS=LG+NF
      LXO=LS+NF
      LGO=LXO+NF
      LXS=LGO+NF
      LGS=LXS+NF
      LGP=LGS+NF
      LAX=LGP+NF
      LAY=LAX+NF*MB
      LAZ=LAY+NF*MB
      LH=LAZ+4*MB
      LPSL=1
      LPERM=LPSL+NF+1
      LINVP=LPERM+NF
      LWN11=LINVP+NF
      LWN12=LWN11+NF+1
      LWN13=LWN12+NF+1
      LWN14=LWN13+NF+1
      LIH=LWN14+NF+1
      LJH=LIH+NF+1
      CALL PSEN (NF, NA, MB, (IFIL+3)*MH, X, IA, AF, RA(LAG), RA(LAGO),
     &RA(LAH), RA(LGA), RA(LG), RA(LH), IA(LIH), IA(LJH), IAG, JAG,
     &RA(LS), RA(LXO), RA(LGO), RA(LXS), RA(LGS), RA(LGP), RA(LAX),
     &RA(LAY), RA(LAZ), IA(LPSL), IA(LPERM), IA(LINVP), IA(LWN11),
     &IA(LWN12), IA(LWN13), IA(LWN14), RPAR(1), RPAR(2), RPAR(3),
     &RPAR(4), RPAR(5), RPAR(6), RPAR(8), RPAR(9), GMAX, F, IPAR(1),
     &IPAR(2), IPAR(4), IPRNT, ITERM)
      DEALLOCATE(IA,RA)
      RETURN
      END
! SUBROUTINE PSEN               ALL SYSTEMS                   01/09/22
! PURPOSE :
! GENERAL SUBROUTINE FOR LARGE-SCALE UNCONSTRAINED MINIMIZATION
! OF NONSMOOTH PARTIALLY SEPARABLE FUNCTIONS.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  II  NA  NUMBER OF LINEAR APPROXIMATED FUNCTIONS.
!  II  MB  DIMENSION OF A BUNDLE USED IN THE LINE SEARCH.
!  II  MMAX  MAXIMUM DIMENSION OF THE SPARSE TABLEAU.
!  RI  X(NF)  VECTOR OF VARIABLES.
!  IA  IX(NF)  AUXILIARY VECTOR.
!  RI  AF(NA)  VECTOR CONTAINING VALUES OF THE APPROXIMATED
!         FUNCTIONS.
!  RA  AG(MA)  JACOBIAN MATRIX OF THE PARTITIONED FUNCTION.
!  RA  AGO(MA)  OLD JACOBIAN MATRIX OF THE PARTITIONED FUNCTION,
!  RA  AH(MB)  ELEMENTS OF THE PARTITIONED HESSIAN MATRIX.
!  RA  GA(NF)  GRADIENT OF THE SELECTED APPROXIMATED FUNCTION.
!  RO  G(NF)  GRADIENT OF THE OBJECTIVE FUNCTION.
!  RA  H(MMAX)  NONZERO ELEMENTS OF THE APPROXIMATION OF THE SPARSE
!         HESSIAN MATRIX TOGETHER WITH AN ADDITIONAL SPACE USED FOR
!         THE NUMERICAL DIFFERENTIATION.
!  II  IH(NF+1)  POINTERS OF DIAGONAL ELEMENTS OF THE MATRIX H.
!  IU  JH(MMAX)  INDICES OF NONZERO ELEMENTS OF THE MATRIX H
!         TOGETHER WITH AN ADDITIONAL SPACE USED FOR THE NUMERICAL
!         DIFFERENTIATION.
!  RI  IAG(NA+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
!  RI  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
!  RA  S(NF)  DIRECTION VECTOR.
!  RA  XO(NF)  VECTORS OF VARIABLES DIFFERENCE.
!  RA  GO(NF)  GRADIENTS DIFFERENCE.
!  RA  XS(NF)  AUXILIARY VECTOR.
!  RA  GS(NF)  AUXILIARY VECTOR.
!  RA  GP(NF)  AUXILIARY VECTOR.
!  RA  AX(NF*MB)  AUXILIARY VECTOR.
!  RA  AY(NF*MB)  AUXILIARY VECTOR.
!  RA  AZ(4*MB)  AUXILIARY VECTOR.
!  IA  PSL(NF+1)  POINTER VECTOR OF THE COMPACT FORM OF THE TRIANGULAR
!         FACTOR OF THE HESSIAN APPROXIMATION.
!  IA  PERM(NF)  PERMUTATION VECTOR.
!  IA  INVP(NF)  INVERSE PERMUTATION VECTOR.
!  IA  WN11(NF+1) AUXILIARY VECTOR.
!  IA  WN12(NF+1) AUXILIARY VECTOR.
!  IA  WN13(NF+1) AUXILIARY VECTOR.
!  IA  WN14(NF+1) AUXILIARY VECTOR.
!  RI  XMAX  MAXIMUM STEPSIZE.
!  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 NORM.
!  RI  FMIN  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!  RI  ETA3  CORRECTION PARAMETER.
!  RI  ETA5  PARAMETER FOR SUBGRADIENT LOCALITY MEASURE.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  II  MIT  MAXIMUM NUMBER OF ITERATIONS.
!  II  MFV  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!  II  IEST  ESTIMATION INDICATOR. IEST=0-MINIMUM IS NOT ESTIMATED.
!         IEST=1-MINIMUM IS ESTIMATED BY THE VALUE FMIN.
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!         VALUES ITERM<=-40 DETECT A LACK OF SPACE.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PA1SF3  COMPUTATION OF THE VALUE AND THE SUBGRADIENT OF A
!         PARTIALLY SEPARABLE OBJECTIVE FUNCTION.
!  S   PFSET3  PREPARATION OF THE SPARSE HESSIAN MATRIX
!  S   PFSET4  PREPARATION OF THE PARTITIONED HESSIAN MATRIX
!  S   PS1L18  SPECIAL NONSMOOTH LINE SEARCH.
!  S   PUBVI2  VARIABLE METRIC UPDATE OF THE PARTITIONED HESSIAN MATRIX.
!  S   PYABU1  DETERMINATION OF THE AGGREGATE SUBGRADIENT AS A SOLUTION
!         OF THE THREE-TERM QUADRATIC PROGRAMMING SUBPROBLEM.
!  S   PYABU2  DETERMINATION OF THE AGGREGATE SUBGRADIENT AS A SOLUTION
!         OF THE TWO-TERM QUADRATIC PROGRAMMING SUBPROBLEM.
!  S   PYBUN1  BUNDLE SELECTION.
!  S   PYTRCD  COMPUTATION OF PROJECTED DIFFERENCES FOR THE VARIABLE MET
!         UPDATE.
!  S   PYTRCG  COMPUTATION OF THE PROJECTED GRADIENT.
!  S   PYTRCS  COMPUTATION OF THE PROJECTED DIRECTION VECTOR.
!  S   PYTSCH  CORRECTION OF THE HESSIAN MATRIX.
!  S   MXBSMI  INITIATION OF THE PARTITIONED HESSIAN MATRIX.
!  S   MXSPCB  BACK SUBSTITUTION USING THE SPARSE DECOMPOSITION
!         OBTAINED BY MXSPCF.
!  S   MXSPCC  SPARSE MATRIX REORDERING, SYMBOLIC FACTORIZATION, DATA
!         STRUCTURES TRANSFORMATION. INITIATION OF THE DIRECT SPARSE
!         SOLVER.
!  S   MXSPCF  GILL-MURRAY DECOMPOSITION OD A SPARSE SYMMETRIC MATRIX.
!  S   MXSPCT  COPYING A SPARSE SYMMETRIC MATRIX INTO THE PERMUTED
!         FACTORIZED COMPACT SCHEME.
!  RF  MXUDOT  DOT PRODUCT OF TWO VECTORS.
!  S   MXUNEG  COPYING OF A VECTOR WITH CHANGE OF THE SIGN.
!  S   MXVCOP  COPYING OF A VECTOR.
!  S   MXVDIR  VECTOR AUGMENTED BY THE SCALED VECTOR.
!  RF  MXVDOT  DOT PRODUCT OF TWO VECTORS.
!  S   MXVINE  RESTORATION OF A SPARSE SYMMETRIC MATRIX OBTAINED BY
!         MXVINB
!  S   MXVINS  INITIATION OF THE INTEGER VECTOR.
!  RF  MXVNOR  EUCLIDEAN NORM OF A VECTOR.
!  S   MXVSAB  SUM OF ABSOLUTE VALUES.
!  S   MXVSBP  INVERSE PERMUTATION OF A VECTOR
!  S   MXVSET  INITIATION OF A VECTOR.
!  S   MXVSFP  PERMUTATION OF A VECTOR.
!
! EXTERNAL SUBROUTINES :
!  SE  FUN  COMPUTATION 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  DFUN  COMPUTATION OF THE SUBGRADIENT OF THE APPROXIMATED FUNCTION
!         CALLING SEQUENCE: CALL DFUN(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 :
! BUNDLE VARIABLE METRIC METHOD FOR MINIMIZATION OF NONSMOOTH PARTIALLY
! SEPARABLE FUNCTIONS.
!
      SUBROUTINE PSEN (NF, NA, MB, MMAX, X, IX, AF, AG, AGO, AH, GA, G,
     &H, IH, JH, IAG, JAG, S, XO, GO, XS, GS, GP, AX, AY, AZ, PSL, PERM,
     & INVP, WN11, WN12, WN13, WN14, XMAX, TOLX, TOLF, TOLB, TOLG, FMIN,
     & ETA3, ETA5, GMAX, F, MIT, MFV, IEST, IPRNT, ITERM)
      INTEGER NA,NF,MB,MMAX,IX(*),IH(*),JH(*),IAG(*),JAG(*),PSL(*),
     &PERM(*),INVP(*),WN11(*),WN12(*),WN13(*),WN14(*),MIT,MFV,MFG,IEST,
     &IPRNT,ITERM
      DOUBLE PRECISION X(*),AF(*),AG(*),AGO(*),AH(*),GA(*),G(*),H(*),S(*
     &),XO(*),GO(*),XS(*),GS(*),GP(*),AX(*),AY(*),AZ(*),XMAX,TOLX,TOLF,
     &TOLB,TOLG,FMIN,ETA3,ETA5,GMAX,F
      INTEGER IDECF,ITERD,ITERS,KD,LD,NTESX,NTESF,MTESX,MTESF,MRED,KIT,
     &IREST,KBF,IOLD,INITD,IER,N,NB,MA,ISYS,KTERS,IRES1,IRES2,NRED,I,
     &INITS,JC,JR,JE,NNK,ITERH,NNV,M,MM,MH,ISNA,MAM,MOS3
      DOUBLE PRECISION R,RO,RP,FO,FP,P,PO,GNORM,SNORM,XNORM,RMIN,RMAX,
     &FMAX,DMAX,UMAX,ETA0,ETA2,ETA9,EPS0,EPS1,EPS2,ALF1,ALF2,POM,ALFN,
     &ALFV,DF
      DOUBLE PRECISION MXVDOT,MXVNOR,MXVSAB
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      INTEGER NEXT
      DOUBLE PRECISION FB
      COMMON /PROB/ FB,NEXT
      IF (ABS(IPRNT).GT.1) WRITE (6,'(1X,''ENTRY TO PSEN :'')')
      KBF=0
      NRES=0
      NDEC=0
      NIN=0
      NIT=0
      NFV=0
      NFG=0
      NFH=0
      ISYS=0
      NTESX=0
      NTESF=0
      MTESX=10
      MTESF=10
      INITS=1
      INITD=1
      ITERM=0
      ITERD=0
      ITERS=2
      ITERH=0
      KTERS=5
      IREST=0
      IRES1=111
      IRES2=999
      IDECF=0
      MRED=20
      MOS3=2
      ETA0=1.0D-15
      ETA2=1.0D-12
      ETA9=1.0D120
      EPS0=1.0D-6
      EPS1=1.0D-4
      EPS2=2.5D-1
      ALF1=1.0D-10
      ALF2=1.0D10
      RMAX=ETA9
      DMAX=ETA9
      FMAX=1.0D20
      IF (IEST.LE.0) FMIN=-1.0D60
      IF (IEST.GT.0) IEST=1
      IF (XMAX.LE.0.0D0) XMAX=1.0D16
      IF (TOLX.LE.0.0D0) TOLX=1.0D-16
      IF (TOLF.LE.0.0D0) TOLF=1.0D-12
      IF (TOLB.LE.0.0D0) TOLB=FMIN+1.0D-12
      IF (TOLG.LE.0.0D0) TOLG=1.0D-8
      IF (ETA3.LE.0.0D0) ETA3=1.0D-12
      IF (ETA5.LE.0.0D0) ETA5=2.5D-1
      IF (MIT.LE.0) MIT=20000
      IF (MFV.LE.0) MFV=20000
      MFG=MFV
      MA=IAG(NA+1)-1
      CALL MXVINP (NF+1, IH)
      CALL MXVINP (NF, JH)
      CALL PFSET3 (NF, NA, M, MMAX, IH, JH, IAG, JAG, ITERM)
      IF (ITERM.LT.0) STOP
      IF (ITERM.NE.0) GO TO 80
      MH=0
      CALL MXVINE (IH(NF+1)-1, JH)
      CALL MXSPCC (NF, M, MH, MMAX, H, IH, JH, PSL, PERM, INVP, WN11,
     &WN12, WN13, WN14, IER)
      IF (IER.NE.0) THEN
        ITERM=IER
      END IF
      IF (ITERM.NE.0) GO TO 70
!
!     BUNDLE VARIABLE METRIC METHOD
!
      LD=-1
      KD=1
      ISNA=2
      KIT=-(IRES1*NF+IRES2)
      FO=FMIN
      NB=0
      JR=0
      JE=0
      NNK=0
      NNV=0
!
!     MODEL DESCRIPTION
!
      CALL PA1SF3 (NF, NA, X, GA, G, AG, IAG, JAG, F, AF, KD, LD, ISNA,
     &NFV, NFG)
!
!     END OF MODEL DESCRIPTION
!
      DF=ABS(F)+1.0D0
      CALL PYBUN1 (NF, MB, NB, X, G, F, AX, AY, AZ, ITERS)
   10 IF (ITERS.GT.0) THEN
        JC=0
        ALFN=0.0D0
        ALFV=0.0D0
        CALL MXVCOP (NF, G, GP)
      END IF
      CALL PYTRCG (NF, N, IX, GP, UMAX, GMAX, KBF, IOLD)
      IF (ITERM.LT.0) GO TO 70
      IF (ABS(IPRNT).GT.1) WRITE (6,'(1X,''NIT='',I5,2X,''NFV='',I5,2X,'
     &'NFG='',I5,2X,       ''F='', G16.9,2X,''G='',E10.3)') NIT,NFV,NFG,
     &F,GMAX
      IF (F.LE.TOLB) THEN
        ITERM=3
        GO TO 70
      END IF
      IF (NIT.GE.MIT) THEN
        ITERM=11
        GO TO 70
      END IF
      IF (NFV.GE.MFV) THEN
        ITERM=12
        GO TO 70
      END IF
      IF (NFG.GE.MFG) THEN
        ITERM=13
        GO TO 70
      END IF
      ITERM=0
      IF (NF.NE.0.AND.NIT-KIT.GE.IRES1*NF+IRES2) THEN
        IREST=MAX(IREST,1)
      END IF
      NIT=NIT+1
   20 IF (IREST.GT.0) THEN
        CALL MXBSMI (NA, AH, IAG)
!      LD=MIN(LD,1)
        IDECF=0
        IF (KIT.LT.NIT) THEN
          NRES=NRES+1
          KIT=NIT
        ELSE
          ITERM=-10
          IF (ITERS.LT.0) ITERM=ITERS-5
        END IF
      END IF
      IF (ITERM.NE.0) GO TO 70
      CALL MXVSET (IH(NF+1)-1, 0.0D0, H)
      CALL PFSET4 (NA, H, IH, JH, AH, IAG, JAG)
      CALL PYTSCH (NF, IX, H, IH, JH, KBF)
      IF (JE.GT.0) GO TO 30
!
!     DIRECTION DETERMINATION
!
      MM=IH(NF+1)-1
      CALL PDSLM1 (NF, MMAX, MH, IX, GP, H, IH, JH, S, XO, PSL, PERM,
     &WN11, WN12, GNORM, SNORM, ETA2, KBF, IDECF, NDEC, ITERD, ITERM)
      JC=1
      IF (JC.EQ.1) THEN
        CALL MXVDIR (NF, -ETA3, GP, S, S)
        SNORM=SQRT(MXVDOT(NF,S,S))
      END IF
!
!     END OF DIRECTION DETERMINATION
!
      IF (KD.GT.0) P=MXVDOT(NF,GP,S)
!
!     TEST ON DESCENT DIRECTION AND PREPARATION OF LINE SEARCH
!
      IF (ITERD.LT.0) THEN
        ITERM=ITERD
      ELSE
!
!     TEST ON DESCENT DIRECTION
!
        IF (SNORM.LE.0.0D0) THEN
          IREST=MAX(IREST,1)
        ELSE IF (P+EPS0*GNORM*SNORM.LE.0.0D0) THEN
          IREST=0
        ELSE
!
!     UNIFORM DESCENT CRITERION
!
          IREST=MAX(IREST,1)
        END IF
        IF (IREST.EQ.0) THEN
!
!     PREPARATION OF LINE SEARCH
!
          NRED=0
          RMIN=ALF1*GNORM/SNORM
          RMAX=MIN(ALF2*GNORM/SNORM,XMAX/SNORM)
        END IF
      END IF
      IF (ITERS.EQ.0) IREST=0
      IF (SNORM.LE.0.0D0) IREST=0
      IF (ITERM.NE.0) GO TO 70
      IF (IREST.NE.0) GO TO 20
      XNORM=-P+2.0D0*ALFV
   30 CONTINUE
      IF (XNORM.LE.TOLG) THEN
        IF (SNORM.LE.0.0D0) ITERM=4
        NTESX=NTESX+1
        IF (ITERS.GT.0.AND.DF.LT.1.0D2*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 70
      IF (SNORM.GT.0.0D0) RMAX=XMAX/SNORM
      RMIN=MIN(1.0D-10,RMAX/1.0D1)
      CALL PYTRCS (NF, X, IX, XO, X, X, G, GO, S, RO, FP, FO, F, PO, P,
     &RMAX, ETA9, KBF)
      CALL MXVCOP (MA, AG, AGO)
      IF (RMAX.LE.RMIN) THEN
        R=0.0D0
        GO TO 60
      END IF
   40 CALL PS1L18 (NF, MB, NB, X, G, S, XO, AZ, AY, AX, R, RP, FO, F,
     &PO, P, RMIN, RMAX, SNORM, XNORM, EPS1, EPS2, ETA5, ETA9, KD, LD,
     &JE, MOS3, ITERS, ISYS)
      IF (ISYS.EQ.0) GO TO 50
      CALL MXVDIR (NF, R, S, XO, X)
      CALL PA1SF3 (NF, NA, X, GA, G, AG, IAG, JAG, F, AF, KD, LD, ISNA,
     &NFV, NFG)
      P=MXVDOT(NF,G,S)
      GO TO 40
   50 CONTINUE
      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) THEN
        NTESF=NTESF+1
        IF (NTESF.GE.MTESF) THEN
          F=FO
          ITERM=2
          GO TO 70
        END IF
      ELSE
        NTESF=0
      END IF
      CALL PYBUN1 (NF, MB, NB, X, G, F, AX, AY, AZ, ITERS)
      IF (ITERS.EQ.0) THEN
        NNK=NNK+1
        ALFN=MAX(ABS(FO-F+P*R),ETA5*(SNORM*R)**MOS3)
        MAM=MA
        IF (NNK.EQ.1) THEN
          CALL PYABU2 (NF, H(MM+1), JH(MM+1), PSL, PERM, G, GP, S, GS,
     &     ALFN, ALFV, ETA3, JC)
        ELSE
          CALL PYABU1 (NF, H(MM+1), JH(MM+1), PSL, PERM, G, GO, GP, S,
     &     GS, XS, ALFN, ALFV, ETA3, JC)
        END IF
        F=FO
      ELSE
        NNK=0
      END IF
      POM=P
      CALL PYTRCD (NF, X, IX, XO, G, GO, R, F, FO, P, PO, DMAX, KBF, KD,
     & LD, ITERS)
      P=POM
      POM=MXVSAB(NF,GO)
      IF (POM.EQ.0.0D0.AND.ITERS.GT.0) THEN
        ITERM=6
        GO TO 70
      ELSE
        JE=0
      END IF
      POM=MXVDOT(NF,XO,GO)
      IF (POM.GT.R*0.0D0.AND.ABS(POM).GT.1.0D-6*MXVNOR(NF,XO)*MXVNOR(NF,
     &GO)) THEN
        IDECF=0
        CALL PUBVI2 (NA, AH, IAG, JAG, AG, AGO, XO, S, GS, ETA9, NNK,
     &   NIT, ITERH)
      END IF
   60 CONTINUE
      GO TO 10
   70 CONTINUE
      GMAX=XNORM
   80 CONTINUE
      IF (IPRNT.GT.1.OR.IPRNT.LT.0) WRITE (6,'(1X,''EXIT FROM PSUM :'')'
     &)
      IF (IPRNT.NE.0) WRITE (6,'(1X,''NIT='',I5,2X,''NFV='',I5,2X,''NFG=
     &'',I5,2X,       ''F='', G16.9,2X,''G='',E10.3,2X,''ITERM='',I3)')
     &NIT,NFV,NFG,F,GMAX,ITERM
      IF (IPRNT.LT.0) WRITE (6,'(1X,''X='',5(G14.7,1X):/(3X,5(G14.7,1X))
     &)') (X(I),I=1,NF)
      END
! SUBROUTINE PSUMU              ALL SYSTEMS                   97/01/22
! PURPOSE :
! EASY TO USE SUBROUTINE FOR LARGE-SCALE UNCONSTRAINED MINIMIZATION OF
! SUMS OF ABSOLUTE VALUES WITH SPARSE JACOBIAN MATRICES.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  II  NA  NUMBER OF PARTIAL FUNCTIONS.
!  IU  MA  NUMBER OF NONZERO ELEMENTS IN THE JACOBIAN MATRIX.
!  RI  X(NF)  VECTOR OF VARIABLES.
!  RO  AF(NA)  VECTOR CONTAINING VALUES OF PARTIAL FUNCTIONS.
!  RI  IAG(NA+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE JACOBIAN
!         MATRIX.
!  RI  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE JACOBIAN MATRIX.
!  II  IPAR(7)  INTEGER PAREMETERS:
!      IPAR(1)  MAXIMUM NUMBER OF ITERATIONS.
!      IPAR(2)  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!      IPAR(3)  MAXIMUM NUMBER OF GRADIENT EVALUATIONS.
!      IPAR(4)  ESTIMATION INDICATOR. IPAR(4)=0-MINIMUM IS NOT
!         ESTIMATED. IPAR(4)=1-MINIMUM IS ESTIMATED BY THE VALUE
!         RPAR(6).
!      IPAR(5)  METHOD USED. IPAR(5)=1-PARTITIONED VARIABLE METRIC
!         METHOD. IPAR(5)=2-DISCRETE NEWTON METHOD.
!      IPAR(6)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PSUM.
!      IPAR(7)  NUMBER DEFINING THE SPACE FOR FILL-IN (THE SIZE OF THIS
!         SPACE IS IFIL TIMES THE STANDARD SIZE). THE DEFAULT VALUE IS
!         IFIL=1. THE DEFAULT VALUE HAS TO BE INCREASED IF ITERM IS
!         LESS OR EQUAL TO -40.
!  RI  RPAR(9)  REAL PARAMETERS:
!      RPAR(1)  MAXIMUM STEPSIZE.
!      RPAR(2)  TOLERANCE FOR THE CHANGE OF VARIABLES.
!      RPAR(3)  TOLERANCE FOR THE CHANGE OF FUNCTION VALUES.
!      RPAR(4)  TOLERANCE FOR THE FUNCTION FALUE.
!      RPAR(5)  TOLERANCE FOR THE GRADIENT NORM.
!      RPAR(6)  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!      RPAR(7)  INITIAL TRUST-REGION RADIUS.
!      RPAR(8)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PSUM.
!      RPAR(9)  MINIMUM PERMITTED VALUE OF THE BARRIER PARAMETER.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  II  ISPAS  INPUT SPARSE STRUCTURE. ISPAS=1-STANDARD COORDINATE
!         FORM. ISPAS=2-SPARSE STRUCTURE COMPRESSED BY ROWS.
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!         VALUES ITERM<=-40 DETECT A LACK OF SPACE. IN THIS CASE,
!         PARAMETER IPAR(7) HAS TO BE INCREASED.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PSUM  PRIMAL TRUST-REGION INTERIOR-POINT METHOD FOR LARGE-SCALE
!         PARTIALLY SEPARABLE SUMS OF ABSOLUTE VALUES.
!  S   PASED3  COMPRESSED SPARSE STRUCTURE OF THE JACOBIAN MATRIX IS
!         COMPUTED FROM THE COORDINATE FORM.
!  S   PFSET2  NUMBER OF NONZERO ELEMENTS IN THE PARTITIONED HESSIAN
!         MATRIX.
!
! EXTERNAL SUBROUTINES :
!  SE  FUN  COMPUTATION 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  DFUN  COMPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION.
!         CALLING SEQUENCE: CALL DFUN(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 PSUMU (NF, NA, MA, X, AF, IAG, JAG, IPAR, RPAR, F,
     &GMAX, ISPAS, IPRNT, ITERM)
      INTEGER NF,NA,MA,IAG(*),JAG(*),IPAR(7),ISPAS,IPRNT,ITERM
      DOUBLE PRECISION X(*),AF(*),RPAR(9),F,GMAX
      INTEGER LAFO,LAG,LAGO,LGA,LAH,LAS,LAZ,LG,LH,LS,LXO,LGO,LGS,LIH,
     &LJH,LCOL,LPSL,LPERM,LINVP,LWN11,LWN12,LWN13,LWN14,MB,MC
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH,IFIL,IER
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      INTEGER IA(:)
      DOUBLE PRECISION RA(:)
      ALLOCATABLE IA,RA
      IFIL=IPAR(7)
      IF (IFIL.LE.0) IFIL=1
      IF (ISPAS.LE.1) THEN
        CALL PASED3 (NF, NA, MA, IAG, JAG, IER)
        IF (IER.NE.0) THEN
          WRITE (6,'(''INPUT ERROR : IER = '',I3)') IER
          STOP
        END IF
      ELSE
        MA=IAG(NA+1)-1
      END IF
      CALL PFSET2 (NA, MB, MC, IAG)
      ALLOCATE(IA(NA+9*NF+7+(IFIL+3)*MB))
      IF (IPAR(5).LE.1) THEN
        ALLOCATE(RA(2*MA+3*NA+6*NF+1+(IFIL+4)*MB))
      ELSE
        ALLOCATE(RA(MA+3*NA+6*NF+1+(IFIL+3)*MB))
      END IF
!
!     POINTERS FOR AUXILIARY ARRAYS
!
      LAFO=1
      LAG=LAFO+NA
      IF (IPAR(5).LE.1) THEN
        LAGO=LAG+MA
        LAH=LAGO+MA
        LGA=LAH+MB
      ELSE
        LAGO=LAG
        LAH=LAG
        LGA=LAG+MA
      END IF
      LAS=LGA+NF
      LAZ=LAS+NA
      LG=LAZ+NA
      LS=LG+NF
      LXO=LS+NF
      LGO=LXO+NF
      LGS=LGO+NF+1
      LH=LGS+NF
      LCOL=NA+1
      LPSL=LCOL+NF
      LPERM=LPSL+NF+1
      LINVP=LPERM+NF
      LWN11=LINVP+NF
      LWN12=LWN11+NF+1
      LWN13=LWN12+NF+1
      LWN14=LWN13+NF+1
      LIH=LWN14+NF+1
      LJH=LIH+NF+1
      CALL PSUM (NF, NA, (IFIL+3)*MB, X, IA, AF, RA(LAFO), RA(LAG),
     &RA(LAGO), RA(LGA), RA(LAH), RA(LAS), RA(LAZ), RA(LG), RA(LH),
     &IA(LIH), IA(LJH), IA, IAG, JAG, RA(LS), RA(LXO), RA(LGO), RA(LGS),
     & IA(LCOL), IA(LPSL), IA(LPERM), IA(LINVP), IA(LWN11), IA(LWN12),
     &IA(LWN13), IA(LWN14), RPAR(1), RPAR(2), RPAR(3), RPAR(4), RPAR(5),
     & RPAR(6), RPAR(7), RPAR(9), GMAX, F, IPAR(1), IPAR(2), IPAR(3),
     &IPAR(4), IPAR(5), IPRNT, ITERM)
      DEALLOCATE(IA,RA)
      RETURN
      END
! SUBROUTINE PSUM               ALL SYSTEMS                   01/09/22
! PURPOSE :
! GENERAL SUBROUTINE FOR LARGE-SCALE UNCONSTRAINED MINIMIZATION OF
! SUMS OF ABSOLUTE VALUES WITH SPARSE JACOBIAN MATRICES.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  II  NA  NUMBER OF PARTIAL FUNCTIONS.
!  II  MMAX  MAXIMUM DIMENSION OF THE SPARSE TABLEAU.
!  RI  X(NF)  VECTOR OF VARIABLES.
!  IA  IX(NF)  AUXILIARY VECTOR.
!  RO  AF(NA)  VECTOR CONTAINING VALUES OF THE APPROXIMATED
!         FUNCTIONS.
!  RA  AFO(NA)  AUXILIARY VECTOR.
!  RA  AG(MA)  JACOBIAN MATRIX OF THE PARTIALLY SEPARABLE FUNCTION.
!  RA  AGO(NA)  AUXILIARY VECTOR.
!  RA  GA(NF)  GRADIENT OF THE SELECTED PARTIAL FUNCTION.
!  RA  AH(MB)  HESSIAN MATRIX OF THE PARTIALLY SEPARABLE FUNCTION.
!  RA  AS(NA)  AUXILIARY VECTOR.
!  RA  AZ(NA)  VECTOR OF LAGRANGE MULTIPLIERS.
!  RO  G(NF)  GRADIENT OF THE OBJECTIVE FUNCTION.
!  RA  H(MMAX)  NONZERO ELEMENTS OF THE APPROXIMATION OF THE SPARSE
!         HESSIAN MATRIX TOGETHER WITH AN ADDITIONAL SPACE USED FOR
!         THE NUMERICAL DIFFERENTIATION.
!  IA  IH(NF+1)  POINTERS OF DIAGONAL ELEMENTS OF THE MATRIX H.
!  IA  JH(MMAX)  INDICES OF NONZERO ELEMENTS OF THE MATRIX H
!         TOGETHER WITH AN ADDITIONAL SPACE USED FOR THE NUMERICAL
!         DIFFERENTIATION.
!  IA  IA(NA)  AUXILIARY VECTOR.
!  II  IAG(NA+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
!  II  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
!  RA  S(NF)  DIRECTION VECTOR.
!  RA  XO(NF)  VECTORS OF VARIABLES DIFFERENCE.
!  RA  GO(NF)  GRADIENTS DIFFERENCE.
!  RA  GS(NF)  AUXILIARY VECTOR.
!  IA  COL(NF)  AUXILIARY ARRAY.
!  IA  PSL(NF+1)  POINTER VECTOR OF THE COMPACT FORM OF THE TRIANGULAR
!         FACTOR OF THE HESSIAN APPROXIMATION.
!  IA  PERM(NF)  PERMUTATION VECTOR.
!  IA  INVP(NF)  INVERSE PERMUTATION VECTOR.
!  IA  WN11(NF+1) AUXILIARY VECTOR.
!  IA  WN12(NF+1) AUXILIARY VECTOR.
!  IA  WN13(NF+1) AUXILIARY VECTOR.
!  IA  WN14(NF+1) AUXILIARY VECTOR.
!  RI  XMAX  MAXIMUM STEPSIZE.
!  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 NORM.
!  RI  FMIN  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!  RI  XDEL  TRUST REGION STEPSIZE.
!  RI  ETA5  MINIMUM PERMITTED VALUE OF THE BARRIER PARAMETER.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  II  MIT  MAXIMUM NUMBER OF ITERATIONS.
!  II  MFV  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
!  II  MFG  MAXIMUM NUMBER OF GRADIENT EVALUATIONS.
!  II  IEST  ESTIMATION INDICATOR. IEST=0-MINIMUM IS NOT ESTIMATED.
!         IEST=1-MINIMUM IS ESTIMATED BY THE VALUE FMIN.
!  II  MED  METHOD USED. MED=1-PARTITIONED VARIABLE METRIC METHOD.
!         MED=2-DISCRETE NEWTON METHOD.
!  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  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) 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=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!         VALUES ITERM<=-40 DETECT A LACK OF SPACE.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PALNG3  EXTRACTION OF THE PARTIAL GRADIENT.
!  S   PASSH3  MODIFICATION OF THE HESSIAN MATRIX.
!  S   PNSTEP  REALIZATION OF THE BOUNDARY STEP.
!  S   PF1HS2  NUMERICAL COMPUTATION OF THE HESSIAN MATRIX USING
!         DIFFERENCES OF GRADIENTS.
!  S   PFSEB5  COMPUTATION OF THE SPARSE HESSIAN MATRIX FROM THE
!         PARTITIONED HESSIAN MATRIX IN THE L-ONE CASE.
!  S   PFSET2  NUMBER OF NONZERO ELEMENTS IN THE PARTITIONED HESSIAN
!         MATRIX.
!  S   PFSET3  PREPARATION OF THE SPARSE NORMAL EQUATION MATRIX
!         STRUCTURE.
!  S   PP0BA1  COMPUTATION OF THE VALUE OF THE BARRIER FUNCTION.
!  S   PP1SA3  COMPUTATION OF THE VALUE AND THE GRADIENT OF THE
!         LAGRANGIAN FUNCTION.
!  S   PPLAG1  DETERMINATION OF THE LAGRANGE MULTIPLIERS.
!  S   PS0G01  STEPSIZE SELECTION USING TRUST REGION.
!  S   PUBBM2  VARIABLE METRIC UPDATES OF THE PARTITIONED MATRIX.
!  S   PYFUT8  TEST ON TERMINATION.
!  S   PYTCAB  SCALED DIFFERENCE OF THE JACOBIAN MATRICES IN THE L-ONE
!  S   PYPTSH  DETERMINATION OF GROUPS FOR NUMERICAL DIFFERENTIATION.
!  S   PYTRCD  COMPUTATION OF PROJECTED DIFFERENCES FOR THE VARIABLE MET
!         UPDATE.
!  S   PYTRCG  COMPUTATION OF THE PROJECTED GRADIENT.
!  S   PYTRCS  COMPUTATION OF THE PROJECTED DIRECTION VECTOR.
!  S   PYTSCH  CORRECTION OF THE HESSIAN MATRIX.
!  S   MXBSMI  INITIATION OF THE PARTITIONED MATRIX.
!  S   MXSPCB  BACK SUBSTITUTION USING THE SPARSE DECOMPOSITION
!         OBTAINED BY MXSPCF.
!  S   MXSPCC  SPARSE MATRIX REORDERING, SYMBOLIC FACTORIZATION, DATA
!         STRUCTURES TRANSFORMATION. INITIATION OF THE DIRECT SPARSE
!         SOLVER.
!  S   MXSPCF  GILL-MURRAY DECOMPOSITION OD A SPARSE SYMMETRIC MATRIX.
!  S   MXSPCM  MATRIX-VECTOR PRODUCT USING THE SPARSE DECOMPOSITION
!         OBTAINED BY MXSPCF.
!  RF  MXSPCQ  GENERALIZED DOT PRODUCT USING THE SPARSE DECOMPOSITION
!         OBTAINED BY MXSPCF.
!  S   MXSPCT  COPYING A SPARSE SYMMETRIC MATRIX INTO THE PERMUTED
!         FACTORIZED COMPACT SCHEME.
!  RF  MXSSMQ  COMPUTATION OF THE SPARSE QUADRATIC TERM.
!  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.
!  S   MXVINE  RESTORATION OF A SPARSE SYMMETRIC MATRIX OBTAINED BY
!         MXVINB
!  S   MXVINS  INITIATION OF THE INTEGER VECTOR.
!  S   MXVNEG  COPYING OF A VECTOR WITH CHANGE OF THE SIGN.
!  S   MXVSBP  INVERSE PERMUTATION OF A VECTOR
!  S   MXVSCL  SCALING OF A VECTOR.
!  S   MXVSET  INITIATION OF A VECTOR.
!  S   MXVSFP  PERMUTATION OF A VECTOR.
!
! EXTERNAL SUBROUTINES :
!  SE  FUN  COMPUTATION 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  DFUN  COMPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION.
!         CALLING SEQUENCE: CALL DFUN(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 :
! TRUST-REGION INTERIOR-POINT METHOD FOR LARGE SPARSE SUMS OF ABSOLUTE
!         VALUES.
!
      SUBROUTINE PSUM (NF, NA, MMAX, X, IX, AF, AFO, AG, AGO, GA, AH,
     &AS, AZ, G, H, IH, JH, IA, IAG, JAG, S, XO, GO, GS, COL, PSL, PERM,
     & INVP, WN11, WN12, WN13, WN14, XMAX, TOLX, TOLF, TOLB, TOLG, FMIN,
     & XDEL, ETA5, GMAX, F, MIT, MFV, MFG, IEST, MED, IPRNT, ITERM)
      INTEGER NF,NA,MMAX,IX(*),IH(*),JH(*),IA(*),IAG(*),JAG(*),COL(*),
     &PSL(*),PERM(*),INVP(*),WN11(*),WN12(*),WN13(*),WN14(*),MIT,MFV,
     &MFG,IEST,MED,IPRNT,ITERM
      DOUBLE PRECISION X(*),AF(*),AFO(*),AG(*),AGO(*),GA(*),AH(*),AS(*),
     &AZ(*),G(*),H(*),S(*),XO(*),GO(*),GS(*),XMAX,TOLX,TOLF,TOLG,TOLB,
     &XDEL,ETA5,FMIN,GMAX,F
      INTEGER IDECF,ITERD,ITERS,KD,LD,NTESX,NTESF,MTESX,MTESF,MRED,KIT,
     &IREST,KBF,MAXST,IDIR,IOLD,INF,INITD,ITERH,IER,ISYS,KTERS,IRES1,
     &IRES2,NRED,MET,MET1,MET3,MET5,I,J,MES1,MES2,MES3,M,MA,MB,MM,MH,
     &JSTRT,JSTOP,KA,ISNA
      DOUBLE PRECISION R,RO,FF,FO,FP,FA,P,PO,PP,GNORM,SNORM,RMAX,DMAX,
     &UMAX,XDELO,ETA0,ETA2,ETA6,EPS4,EPS5,ETA9,ALF,BET1,BET2,GAM1,GAM2,
     &TOLP,RHO,RPF3,FFO,B1,B2,B3
      DOUBLE PRECISION MXVDOT,MXSSMQ,MXSPCQ
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      IF (ABS(IPRNT).GT.1) WRITE (6,'(1X,''ENTRY TO PSUM :'')')
!
!     INITIATION OF PROBLEM
!
      KBF=0
      NRES=0
      NDEC=0
      NIN=0
      NIT=0
      NFV=0
      NFG=0
      NFH=0
      IDIR=0
      ISYS=0
      NTESX=0
      NTESF=0
      MTESX=2
      MTESF=2
      INITD=1
      ITERM=0
      ITERD=0
      ITERS=2
      ITERH=0
      KTERS=0
      IREST=0
      IRES1=999
      IRES2=0
      MRED=10
      MES1=3
      MES2=2
      MES3=1
      ETA0=1.0D-15
      ETA2=1.0D-18
      ETA6=1.0D0
      ETA9=1.0D120
      EPS4=0.10D0
      EPS5=0.90D0
      BET1=0.05D0
      BET2=0.75D0
      GAM1=2.0D0
      GAM2=1.0D6
      RPF3=1.0D0
      RMAX=ETA9
      DMAX=ETA9
      IF (IEST.LE.0) FMIN=0.0D0
      FMIN=MAX(FMIN,0.0D0)
      IEST=1
      IF (XMAX.LE.0.0D0) XMAX=1.0D16
      XDEL=MIN(XDEL,XMAX)
      IF (TOLX.LE.0.0D0) TOLX=1.0D-16
      IF (TOLF.LE.0.0D0) TOLF=1.0D-12
      IF (TOLB.LE.0.0D0) TOLB=FMIN+1.0D-12
      IF (TOLG.LE.0.0D0) TOLG=1.0D-6
      IF (MIT.LE.0) MIT=10000
      IF (MFV.LE.0) MFV=10000
      IF (MFG.LE.0) MFG=20000
      IF (MED.LE.0) MED=1
      IF (MED.EQ.1) THEN
        MET=1
        MET1=3
        MET3=1
        MET5=1
        KIT=-(IRES1*NF+IRES2)
        CALL PFSET2 (NA, MB, MA, IAG)
        MA=IAG(NA+1)-1
      ELSE
        MED=2
        KIT=0
      END IF
      CALL MXVINP (NF+1, IH)
      CALL MXVINP (NF, JH)
      CALL PFSET3 (NF, NA, M, MMAX, IH, JH, IAG, JAG, ITERM)
      IF (ITERM.NE.0) GO TO 130
      CALL MXVINS (NA, 3, IA)
      IF (MED.EQ.2) CALL PYPTSH (NF, MMAX, IH, JH, COL, S, XO, GO, WN11,
     & WN12, GA, ITERM)
      MH=0
      CALL MXVINE (IH(NF+1)-1, JH)
      CALL MXSPCC (NF, M, MH, MMAX, H, IH, JH, PSL, PERM, INVP, WN11,
     &WN12, WN13, WN14, IER)
      IF (IER.NE.0) THEN
        ITERM=IER
      END IF
!
!     SPARSE NEWTON METHOD
!
      ISNA=2
      KD=MED
      LD=-1
      R=0.0D0
      FO=FMIN
      IF (ETA5.LE.0.0D0) THEN
!      TOLP=SQRT(ETA0)
        TOLP=1.0D-8
      ELSE
        TOLP=ETA5
      END IF
      IF (ITERM.NE.0) GO TO 130
!
!     COMPUTATION OF THE VALUE OF THE LAGRANGIAN FUNCTION
!
   10 KD=0
      CALL PP1SA3 (NF, NA, X, GA, AG, IAG, JAG, G, AZ, FA, AF, FF, KD,
     &LD, NFV, NFG, ISNA)
      LD=0
      CALL PPLAG1 (NA, AF, AS, AZ, RPF3)
      CALL PP0BA1 (NA, AS, RPF3, F)
!
!     COMPUTATION OF THE GRADIENT AND THE HESSIAN MATRIX OF THE
!     LAGRANGIAN FUNCTION
!
      KD=1
      CALL PP1SA3 (NF, NA, X, GA, AG, IAG, JAG, G, AZ, FA, AF, FF, KD,
     &LD, NFV, NFG, ISNA)
      LD=1
      IF (MED.EQ.1) GO TO 30
   20 CALL PF1HS2 (NF, MH, MMAX, X, IH, S, H, IH, JH, GO, G, COL, WN11,
     &WN12, GS, FF, ETA0, 0, ITERM, ISYS)
      IF (ISYS.GT.0) THEN
        LD=0
        ISNA=0
        CALL PP1SA3 (NF, NA, X, GA, AG, IAG, JAG, GO, AZ, FA, AF, FF,
     &   KD, LD, NFV, NFG, ISNA)
        GO TO 20
      END IF
      KD=2
      LD=2
      ISNA=2
      IDECF=0
   30 CONTINUE
      IF (NIT.NE.0) GO TO 120
   40 CALL PYTRCG (NF, NF, IX, G, UMAX, GMAX, KBF, IOLD)
      IF (ABS(IPRNT).GT.1) WRITE (6,'(1X,''NIT='',I5,2X,''NFV='',I5,2X,'
     &'NFG='',I5,2X,       ''F='', G16.9,2X,''G='',E10.3)') NIT,NFV,NFG,
     &F,GMAX
      CALL PYFUT8 (NF, FF, FFO, GMAX, DMAX, RPF3, TOLX, TOLF, TOLB,
     &TOLG, TOLP, KD, NIT, KIT, MIT, NFV, MFV, NFG, MFG, NTESX, MTESX,
     &NTESF, MTESF, IRES1, IRES2, IREST, ITERS, ITERM)
      IF (ITERM.NE.0) GO TO 130
   50 IF (IREST.GT.0) THEN
        IF (MED.EQ.1) THEN
          CALL MXBSMI (NA, AH, IAG)
        ELSE
          RHO=GMAX/1.0D1
          DO 70 I=1,NF
            JSTRT=IH(I)
            JSTOP=IH(I+1)-1
            H(JSTRT)=MIN(MAX(RHO*ABS(H(JSTRT)),5.0D-3),5.0D2)
            DO 60 J=JSTRT+1,JSTOP
              H(J)=0.0D0
   60       CONTINUE
   70     CONTINUE
        END IF
        IDECF=0
        IF (KIT.LT.NIT) THEN
          NRES=NRES+1
          KIT=NIT
        ELSE
          ITERM=-10
          IF (ITERS.LT.0) ITERM=ITERS-5
          IF (GMAX.LE.1.0D3*TOLG.OR.FF.LE.1.0D-8) ITERM=-ITERM
        END IF
      END IF
      IF (ITERM.NE.0) GO TO 130
      IF (MED.EQ.1) THEN
        CALL MXVSET (IH(NF+1)-1, 0.0D0, H)
        CALL PFSEB5 (NA, H, IH, JH, AH, IAG, JAG, AZ, MET5)
      ELSE
        CALL PYTSCH (NF, IX, H, IH, JH, KBF)
      END IF
!
!     DIRECTION DETERMINATION
!
      B2=MXVDOT(NF,G,G)
      GNORM=SQRT(B2)
      DO 80 KA=1,NA
        ALF=2.0D0*RPF3/(AS(KA)**2+AF(KA)**2)
        CALL PALNG3 (AG, IAG, JAG, GO, KA)
        CALL PASSH3 (H, IH, JH, IAG, JAG, GO, KA, ALF)
   80 CONTINUE
      IF (IDECF.NE.0.AND.IDECF.NE.1) THEN
        ITERD=-1
        GO TO 90
      END IF
      INITD=MAX(ABS(INITD),1)
      MM=IH(NF+1)-1
      IF (IDECF.EQ.0) THEN
        B1=MXSSMQ(NF,H,IH,JH,G,G)
      ELSE
        CALL MXVCOP (NF, G, GO)
        CALL MXVSFP (NF, PERM, GO, XO)
        CALL MXSPCM (NF, H(MM+1), PSL, JH(MM+1), GO, XO, 1)
        B1=MXSPCQ(NF,H(MM+1),PSL,GO)
      END IF
      IF (XDEL.LE.0.0D0) THEN
!
!     INITIAL TRUST REGION BOUND
!
        IF (B1.LE.0.0D0) THEN
          XDEL=GNORM
        ELSE
          XDEL=(B2/B1)*GNORM
        END IF
        XDEL=MIN(XDEL,XMAX)
      END IF
      IF (B1.LE.0.0D0.OR.B2*GNORM.GE.B1*XDEL) THEN
!
!     SCALED STEEPEST DESCENT DIRECTION IS ACCEPTED
!
        CALL MXVSCL (NF, -XDEL/GNORM, G, S)
        SNORM=XDEL
        ITERD=3
        GO TO 90
      END IF
      IF (IDECF.EQ.0) THEN
        CALL MXSPCT (NF, MM, MH, MMAX, H, JH, PSL, ITERM)
        IF (ITERM.NE.0) THEN
          GO TO 90
        END IF
!
!     SPARSE GILL-MURRAY DECOMPOSITION
!
        RHO=ETA2
        CALL MXSPCF (NF, H(MM+1), PSL, JH(MM+1), WN11, WN12, XO, INF,
     &   RHO, ALF)
        NDEC=NDEC+1
        IDECF=1
      END IF
!
!     COMPUTATION OF THE NEWTON DIRECTION
!
      CALL MXVNEG (NF, G, GO)
      CALL MXVSFP (NF, PERM, GO, XO)
      CALL MXSPCB (NF, H(MM+1), PSL, JH(MM+1), GO, 0)
      CALL MXVSBP (NF, PERM, GO, XO)
      RHO=SQRT(MXVDOT(NF,GO,GO))
!
!     COMPUTATION OF THE STEEPEST DESCENT DIRECTION
!
      B2=B2/B1
      SNORM=B2*GNORM
      CALL MXVSCL (NF, -B2, G, S)
      CALL MXVDIF (NF, GO, S, XO)
      B1=MXVDOT(NF,S,XO)
      B2=MXVDOT(NF,XO,XO)
      IF (B2.LE.1.0D-8*XDEL*XDEL) THEN
!
!     NEWTON AND THE STEEPEST DESCENT DIRECTION ARE
!     APPROXIMATELY EQUAL
!
        CALL MXVCOP (NF, GO, S)
        SNORM=RHO
        ITERD=1
      ELSE IF (B1.LE.0.0D0) THEN
!
!     BOUNDARY STEP WITH NEGATIVE INCREMENT
!
        CALL PNSTEP (XDEL, SNORM, -B1, B2, B3)
        CALL MXVDIR (NF, -B3, XO, S, S)
        SNORM=XDEL
        ITERD=3
      ELSE IF (RHO.LE.XDEL) THEN
!
!     NEWTON DIRECTION IS ACCEPTED
!
        CALL MXVCOP (NF, GO, S)
        SNORM=RHO
        ITERD=1
      ELSE
!
!     DOUBLE DOGLEG STRATEGY
!
        RHO=XDEL/RHO
        B3=MXVDOT(NF,S,GO)
        RHO=MAX(RHO,SNORM*SNORM/B3)
        CALL MXVDIR (NF, -RHO, GO, S, XO)
        B1=SNORM*SNORM-RHO*B3
        B2=MXVDOT(NF,XO,XO)
        CALL PNSTEP (XDEL, SNORM, -B1, B2, B3)
        CALL MXVDIR (NF, -B3, XO, S, S)
        SNORM=XDEL
        ITERD=3
      END IF
   90 CONTINUE
      IF (IDECF.EQ.0) THEN
        PP=MXSSMQ(NF,H,IH,JH,S,S)*0.5D0
      ELSE
        CALL MXVCOP (NF, S, GO)
        CALL MXVSFP (NF, PERM, GO, XO)
        CALL MXSPCM (NF, H(MM+1), PSL, JH(MM+1), GO, XO, 1)
        PP=MXSPCQ(NF,H(MM+1),PSL,GO)*0.5D0
        IF (ITERD.EQ.1.AND.INF.NE.0) ITERD=2
      END IF
!
!     END OF DIRECTION DETERMINATION
!
      IF (KD.GT.0) P=MXVDOT(NF,G,S)
!
!     TEST ON LOCALLY CONSTRAINED STEP AND PREPARATION OF STEPSIZE
!     SELECTION
!
      IF (ITERD.LT.0) THEN
        ITERM=ITERD
      ELSE
        IF (SNORM.LE.0.0D0) THEN
          IREST=MAX(IREST,1)
        ELSE
          IREST=0
        END IF
        IF (IREST.EQ.0) THEN
          RMAX=XMAX/SNORM
        END IF
      END IF
      IF (ITERM.NE.0) GO TO 130
      IF (IREST.NE.0) GO TO 50
      IF (NIT.EQ.1) KIT=NIT
      CALL PYTRCS (NF, X, IX, XO, X, X, G, GO, S, RO, FP, FO, F, PO, P,
     &RMAX, ETA9, KBF)
      FFO=FF
      CALL MXVCOP (NA, AF, AFO)
      IF (MED.EQ.1) CALL MXVCOP (MA, AG, AGO)
  100 CALL PS0G01 (R, F, FO, PO, PP, XDEL, XDELO, XMAX, RMAX, SNORM,
     &BET1, BET2, GAM1, GAM2, EPS4, EPS5, KD, LD, IDIR, ITERS, ITERD,
     &MAXST, NRED, MRED, KTERS, MES1, MES2, MES3, ISYS)
      IF (ISYS.EQ.0) GO TO 110
      CALL MXVDIR (NF, R, S, XO, X)
      CALL PP1SA3 (NF, NA, X, GA, AG, IAG, JAG, G, AZ, FA, AF, FF, KD,
     &LD, NFV, NFG, ISNA)
      LD=KD
      CALL PPLAG1 (NA, AF, AS, AZ, RPF3)
      CALL PP0BA1 (NA, AS, RPF3, F)
      GO TO 100
  110 CONTINUE
      KD=MED
      IF (ITERS.LE.0) THEN
        R=0.0D0
        F=FO
        P=PO
        CALL MXVCOP (NF, XO, X)
        IF (ITERS.LT.0) THEN
          RPF3=TOLP
          IREST=MAX(IREST,1)
          LD=KD
          GO TO 50
        END IF
        FF=FFO
        CALL MXVCOP (NA, AFO, AF)
        IF (MED.EQ.1) CALL MXVCOP (MA, AGO, AG)
        IF (IDIR.EQ.0) IREST=MAX(IREST,1)
        LD=KD
        GO TO 50
      END IF
      IF (ITERS.GE.2) THEN
        IF (GNORM.GE.ETA6) THEN
        ELSE
          IF (RPF3.GE.1.0D2*GNORM**2) RPF3=GNORM**2
        END IF
        RPF3=MAX(RPF3,TOLP)
      END IF
      GO TO 10
  120 CONTINUE
      CALL PYTRCD (NF, X, IX, XO, G, GO, R, F, FO, P, PO, DMAX, KBF, KD,
     & LD, ITERS)
      IF (MED.EQ.1) THEN
        CALL PYTCAB (NA, MA, AG, AGO, IAG, AZ, ITERS, MET5)
        IDECF=0
        CALL PUBBM2 (NA, AH, IAG, JAG, S, XO, AGO, ETA0, ETA9, NIT, KIT,
     &    ITERH, MET, MET1, MET3)
        IF (ITERH.NE.0) IREST=MAX(IREST,1)
      END IF
      GO TO 40
  130 CONTINUE
      F=FF
      IF (IPRNT.GT.1.OR.IPRNT.LT.0) WRITE (6,'(1X,''EXIT FROM PSUM :'')'
     &)
      IF (IPRNT.NE.0) WRITE (6,'(1X,''NIT='',I5,2X,''NFV='',I5,2X,''NFG=
     &'',I5,2X,       ''F='', G16.9,2X,''G='',E10.3,2X,''ITERM='',I3)')
     &NIT,NFV,NFG,F,GMAX,ITERM
      IF (IPRNT.LT.0) WRITE (6,'(1X,''X='',5(G14.7,1X):/(3X,5(G14.7,1X))
     &)') (X(I),I=1,NF)
      END
! SUBROUTINE PA0GS3             ALL SYSTEMS                 91/12/01
! PURPOSE :
! NUMERICAL COMPUTATION OF THE GRADIENT OF THE APPROXIMATED
! FUNCTION.
!
! PARAMETERS :
!  II  N  NUMBER OF VARIABLES.
!  II  KA  INDEX OF THE APPROXIMATED FUNCTION.
!  RI  X(N)  VECTOR OF VARIABLES.
!  RO  FA  VALUE OF THE APPROXIMATED FUNCTION.
!  RA  GA(N)  GRADIENT OF THE APPROXIMATED FUNCTION.
!  II  IAG(N+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
!  II  JAG(MA) COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
!  RI  ETA1  PRECISION OF THE COMPUTED FUNCTION VALUES.
!  IU  NAV  NUMBER OF APPROXIMATED FUNCTION EVALUATIONS.
!
! SUBPROGRAMS USED :
!  SE  FUN  COMPUTATION OF THE VALUE OF THE APPROXIMATED FUNCTION.
!
      SUBROUTINE PA0GS3 (N, KA, X, FA, GA, IAG, JAG, ETA1, NAV)
      DOUBLE PRECISION ETA1,FA
      INTEGER KA,N,NAV
      DOUBLE PRECISION GA(*),X(*)
      INTEGER IAG(*),JAG(*)
      DOUBLE PRECISION ETA,FTEMP,XSTEP,XTEMP
      INTEGER IVAR,KVAR
      ETA=SQRT(ETA1)
      FTEMP=FA
      DO 10 KVAR=IAG(KA),IAG(KA+1)-1
        IVAR=JAG(KVAR)
!
!     STEP SELECTION
!
        XSTEP=ETA*MAX(ABS(X(IVAR)),1.0D0)*SIGN(1.0D0,X(IVAR))
        XTEMP=X(IVAR)
        X(IVAR)=X(IVAR)+XSTEP
        XSTEP=X(IVAR)-XTEMP
        NAV=NAV+1
        CALL FUN (N, KA, X, FA)
!
!     NUMERICAL DIFFERENTIATION
!
        GA(IVAR)=(FA-FTEMP)/XSTEP
        X(IVAR)=XTEMP
   10 CONTINUE
      FA=FTEMP
      RETURN
      END
! SUBROUTINE PA0HS3                ALL SYSTEMS                 99/12/01
! PURPOSE :
! NUMERICAL COMPUTATION OF THE HESSIAN MATRIX OF THE APPROXIMATED
! FUNCTION USING ITS VALUES.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  II  KA  INDEX OF THE SELECTED FUNCTION.
!  RI  X(NF)  VECTOR OF VARIABLES.
!  II  IX(NF)  VECTOR CONTAINING TYPES OF BOUNDS.
!  RO  HA(M) HESSIAN MATRIX OF THE APPROXIMATED FUNCTION.
!  RA  GO(NF)  AUXILIARY VECTOR.
!  RA  GS(NF)  AUXILIARY VECTOR.
!  RI  IAG(NA+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
!  RI  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
!  RI  FA  VALUE OF THE SELECTED FUNCTION.
!  RI  ETA1  PRECISION OF THE COMPUTED VALUES.
!  II  KBF  TYPE OF BOUNDS. KBF=0-BOUNDS ARE NOT USED. KBF=1-ONE SIDED
!         BOUNDS. KBF=1-TWO SIDED BOUNDS.
!  IO  NAV  NUMBER OF APPROXIMATED FUNTION VALUES.
!
! SUBPROGRAMS USED :
!  SE  FUN  COMPUTATION OF THE VALUE OF THE APPROXIMATED FUNCTION.
!
      SUBROUTINE PA0HS3 (NF, KA, X, IX, HA, GO, GS, IAG, JAG, FA, ETA1,
     &KBF, NAV)
      INTEGER NF,KA,IX(*),IAG(*),JAG(*),KBF,NAV
      DOUBLE PRECISION X(*),HA(*),GO(*),GS(*),FA,ETA1
      DOUBLE PRECISION XTEMPI,XTEMPJ,FTEMP,ETA
      INTEGER I,J,IJ
      INTEGER IVAR,JVAR,KVAR,LVAR,MVAR
      ETA=ETA1**(1.0D0/3.0D0)
      FTEMP=FA
      MVAR=IAG(KA)-1
      DO 10 KVAR=MVAR+1,IAG(KA+1)-1
        IVAR=ABS(JAG(KVAR))
        IF (KBF.GT.0) THEN
          IF (IX(IVAR).LE.-5) GO TO 10
        END IF
!
!     STEP SELECTION
!
        XTEMPI=X(IVAR)
        IF (XTEMPI.GE.0.0D0) THEN
          GO(IVAR)=ETA*MAX(ABS(XTEMPI),1.0D0)
        ELSE
          GO(IVAR)=-ETA*MAX(ABS(XTEMPI),1.0D0)
        END IF
        X(IVAR)=X(IVAR)+GO(IVAR)
        GO(IVAR)=X(IVAR)-XTEMPI
        CALL FUN (NF, KA, X, FA)
        NAV=NAV+1
        GS(IVAR)=FA
        X(IVAR)=XTEMPI
   10 CONTINUE
!
!     NUMERICAL DIFFERENTIATION
!
      DO 30 KVAR=MVAR+1,IAG(KA+1)-1
        IVAR=ABS(JAG(KVAR))
        IF (KBF.GT.0) THEN
          IF (IX(IVAR).LE.-5) GO TO 30
        END IF
        XTEMPI=X(IVAR)
        X(IVAR)=XTEMPI+GO(IVAR)
        DO 20 LVAR=KVAR,IAG(KA+1)-1
          JVAR=ABS(JAG(LVAR))
          IF (KBF.GT.0) THEN
            IF (IX(JVAR).LE.-5) GO TO 20
          END IF
          XTEMPJ=X(JVAR)
          X(JVAR)=X(JVAR)+GO(JVAR)
          CALL FUN (NF, KA, X, FA)
          NAV=NAV+1
          I=KVAR-MVAR
          J=LVAR-MVAR
          IJ=MAX(I,J)*(MAX(I,J)-1)/2+MIN(I,J)
          HA(IJ)=((FTEMP-GS(IVAR))+(FA-GS(JVAR)))/(GO(IVAR)*GO(JVAR))
          X(JVAR)=XTEMPJ
   20   CONTINUE
        X(IVAR)=XTEMPI
   30 CONTINUE
      FA=FTEMP
      RETURN
      END
! SUBROUTINE PA0SQ3             ALL SYSTEMS                 92/12/01
! PURPOSE :
! COMPUTATION OF THE VALUE AND THE GRADIENT OF THE OBJECTIVE FUNCTION
! WHICH IS DEFINED AS A SUM OF SQUARES.
!
! PARAMETERS:
!  II  N  NUMBER OF VARIABLES.
!  RI  X(N)  VECTOR OF VARIABLES.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RO  AF(N)  VALUES OF THE APPROXIMATED FUNCTIONS.
!  RA  GA(N)  GRADIENT OF THE APPROXIMATED FUNCTION.
!  RI  AG(IAG(N+1)-1)  SPARSE RECTANGULAR MATRIX WHICH IS USED FOR THE
!         DIRECTION VECTOR DETERMINATION.
!  II  IAG(N+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
!  II  JAG(MA) COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
!  RI  G(N)  GRADIENT OF THE OBJECTIVE FUNCTION.
!  RI  ETA1  PRECISION OF THE COMPUTED FUNCTION VALUES.
!  II  KD  DEGREE OF REQUIRED DERIVATIVES.
!  IU  LD  DEGREE OF PREVIOUSLY COMPUTED DERIVATIVES.
!  IO  NFV  NUMBER OF FUNCTION EVALUATIONS.
!  IO  NFG  NUMBER OF GRADIENT EVALUATIONS.
!  II  IDER  DEGREE OF ANALYTICALLY COMPUTED DERIVATIVES (0 OR 1).
!
! SUBPROGRAMS USED :
!  SE  FUN  COMPUTATION OF THE VALUE OF THE APPROXIMATED FUNCTION.
!  S   PA0GS3  NUMERICAL DIFFERENTIATION.
!  S   MXVSET  INITIATION OF A VECTOR.
!
      SUBROUTINE PA0SQ3 (N, X, F, AF, GA, AG, IAG, JAG, G, ETA1, KD, LD,
     & NFV, NFG, IDER)
      DOUBLE PRECISION ETA1,F
      INTEGER IDER,KD,LD,N,NFV,NFG
      DOUBLE PRECISION AF(*),AG(*),G(*),GA(*),X(*)
      INTEGER IAG(*),JAG(*)
      DOUBLE PRECISION FA
      INTEGER J,JP,K,KA,L,NAV
      IF (KD.LE.LD) RETURN
      IF (KD.GE.0.AND.LD.LT.0) THEN
        F=0.0D0
        NFV=NFV+1
      END IF
      IF (KD.GE.1.AND.LD.LT.1) THEN
        CALL MXVSET (N, 0.0D0, G)
        IF (IDER.GT.0) NFG=NFG+1
      END IF
      NAV=0
      DO 30 KA=1,N
        IF (KD.LT.0) GO TO 30
        IF (LD.GE.0) THEN
          FA=AF(KA)
        ELSE
          CALL FUN (N, KA, X, FA)
          AF(KA)=FA
        END IF
        IF (LD.GE.0) GO TO 10
        F=F+FA*FA
   10   IF (KD.LT.1) GO TO 30
        IF (IDER.EQ.0) THEN
          CALL PA0GS3 (N, KA, X, FA, GA, IAG, JAG, ETA1, NAV)
        ELSE
          CALL DFUN (N, KA, X, GA)
        END IF
        K=IAG(KA)
        L=IAG(KA+1)-K
        DO 20 J=1,L
          JP=JAG(K)
          G(JP)=G(JP)+FA*GA(JP)
          AG(K)=GA(JP)
          K=K+1
   20   CONTINUE
   30 CONTINUE
      IF (KD.GE.0.AND.LD.LT.0) F=0.5D0*F
      IF (IDER.EQ.0) NFV=NFV+NAV/N
      LD=KD
      RETURN
      END
! SUBROUTINE PA1HS3                ALL SYSTEMS                99/12/01
! PURPOSE :
! NUMERICAL COMPUTATION OF THE HESSIAN MATRIX OF THE APPROXIMATED
! FUNCTION USING ITS GRADIENTS.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  II  KA  INDEX OF THE SELECTED FUNCTION.
!  RI  X(NF)  VECTOR OF VARIABLES.
!  II  IX(NF)  VECTOR CONTAINING TYPES OF BOUNDS.
!  RO  HA(M) HESSIAN MATRIX OF THE APPROXIMATED FUNCTION.
!  RI  GA(NF)  GRADIENT OF THE APPROXIMATED FUNCTION.
!  RA  GO(NF)  AUXILIARY VECTOR.
!  RI  IAG(NA+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
!  RI  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
!  RI  FA  VALUE OF THE SELECTED FUNCTION.
!  RI  ETA1  PRECISION OF THE COMPUTED VALUES.
!  II  KBF  TYPE OF BOUNDS. KBF=0-BOUNDS ARE NOT USED. KBF=1-ONE SIDED
!         BOUNDS. KBF=2-TWO SIDED BOUNDS.
!  IO  NAG  NUMBER OF APPROXIMATED FUNTION GRADIENTS.
!
! SUBPROGRAMS USED :
!  SE  DFUN  COMPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION.
!
      SUBROUTINE PA1HS3 (NF, KA, X, IX, HA, GA, GO, IAG, JAG, FA, ETA1,
     &KBF, NAG)
      INTEGER NF,KA,IX(*),IAG(*),JAG(*),KBF,NAG
      DOUBLE PRECISION X(*),HA(*),GA(*),GO(*),FA,ETA1
      DOUBLE PRECISION XSTEP,XTEMP,FTEMP,ETA
      INTEGER I,J,IJ
      INTEGER IVAR,JVAR,KVAR,LVAR,MVAR
      ETA=SQRT(ETA1)
      FTEMP=FA
      MVAR=IAG(KA)-1
      DO 20 KVAR=MVAR+1,IAG(KA+1)-1
        IVAR=ABS(JAG(KVAR))
        IF (KBF.GT.0) THEN
          IF (IX(IVAR).LE.-5) GO TO 20
        END IF
!
!     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 DFUN (NF, KA, X, GA)
        NAG=NAG+1
!
!     NUMERICAL DIFFERENTIATION
!
        DO 10 LVAR=MVAR+1,IAG(KA+1)-1
          JVAR=ABS(JAG(LVAR))
          IF (KBF.GT.0) THEN
            IF (IX(JVAR).LE.-5) GO TO 10
          END IF
          I=KVAR-MVAR
          J=LVAR-MVAR
          IJ=MAX(I,J)*(MAX(I,J)-1)/2+MIN(I,J)
          IF (LVAR.GE.KVAR) THEN
            HA(IJ)=(GA(JVAR)-GO(JVAR))/XSTEP
          ELSE
            HA(IJ)=0.5D0*(HA(IJ)+(GA(JVAR)-GO(JVAR))/XSTEP)
          END IF
   10   CONTINUE
        X(IVAR)=XTEMP
   20 CONTINUE
      FA=FTEMP
      RETURN
      END
! SUBROUTINE PA1SF3             ALL SYSTEMS                 97/12/01
! PURPOSE :
! COMPUTATION OF THE VALUE AND THE GRADIENT OF THE OBJECTIVE FUNCTION
! WHICH IS DEFINED AS A SUM OF SQUARES.
!
! PARAMETERS:
!  II  NF  NUMBER OF VARIABLES.
!  II  NA  NUMBER OF APPROXIMATED FUNCTIONS.
!  RI  X(NF)  VECTOR OF VARIABLES.
!  RU  GA(NF)  GRADIENT OF THE APPROXIMATED FUNCTION.
!  RO  G(NF)  GRADIENT OF THE OBJECTIVE FUNCTION.
!  RO  AG(MA)  SPARSE JACOBIAN MATRIX.
!  RI  IAG(NA+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
!  RI  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RO  AF(NA)  VECTOR CONTAINING VALUES OF THE APPROXIMATED
!         FUNCTIONS.
!  II  KD  DEGREE OF REQUIRED DERIVATIVES.
!  IO  LD  DEGREE OF PREVIOUSLY COMPUTED DERIVATIVES.
!  II  ISNA  SAVING SPECIFICATION. ISNA=0-NO SAVING. ISNA=1-FUNCTION
!         VALUES ARE SAVED. ISNA=2-FUNCTION VALUES AND GRADIENTS ARE
!         SAVED.
!  IU  NFV  NUMBER OF OBJECTIVE FUNCTION VALUES COMPUTED.
!  IU  NFG  NUMBER OF OBJECTIVE FUNCTION GRADIENTS COMPUTED.
!
! SUBPROGRAMS USED :
!  SE  FUN  COMPUTATION OF THE VALUE OF THE APPROXIMATED FUNCTION.
!  SE  DFUN  COMPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION.
!  S   MXVSET  INITIATION OF A VECTOR.
!
      SUBROUTINE PA1SF3 (NF, NA, X, GA, G, AG, IAG, JAG, F, AF, KD, LD,
     &ISNA, NFV, NFG)
      INTEGER NF,NA,IAG(*),JAG(*),KD,LD,ISNA,NFV,NFG
      DOUBLE PRECISION X(*),GA(*),G(*),AG(*),F,AF(*)
      INTEGER J,JP,K,L,KA
      DOUBLE PRECISION FA
      IF (KD.LE.LD) RETURN
      IF (KD.GE.0.AND.LD.LT.0) THEN
        F=0.0D0
        NFV=NFV+1
      END IF
      IF (KD.GE.1.AND.LD.LT.1) THEN
        CALL MXVSET (NF, 0.0D0, G)
        NFG=NFG+1
      END IF
      DO 20 KA=1,NA
        IF (KD.LT.0) GO TO 20
        IF (LD.LT.0) THEN
          CALL FUN (NF, KA, X, FA)
          F=F+FA
          AF(KA)=FA
        ELSE
          FA=AF(KA)
        END IF
        IF (KD.LT.1) GO TO 20
        IF (LD.LT.1) THEN
          CALL DFUN (NF, KA, X, GA)
          K=IAG(KA)
          L=IAG(KA+1)-K
          DO 10 J=1,L
            JP=ABS(JAG(K))
            G(JP)=G(JP)+GA(JP)
            IF (ISNA.GT.1) AG(K)=GA(JP)
            K=K+1
   10     CONTINUE
        END IF
   20 CONTINUE
      LD=KD
      RETURN
      END
! SUBROUTINE PA2SF4             ALL SYSTEMS                97/12/01
! PURPOSE :
!  COMPUTATION OF THE VALUE AND THE GRADIENT AND THE HESSIAN MATRIX
!  OF THE OBJECTIVE FUNCTION WHICH IS DEFINED AS A SUM OF SQUARES.
!
! PARAMETERS:
!  II  NF  NUMBER OF VARIABLES.
!  II  NA  NUMBER OF APPROXIMATED FUNCTIONS.
!  RI  X(NF)  VECTOR OF VARIABLES.
!  II  IX(NF)  VECTOR CONTAINING TYPES OF BOUNDS.
!  RU  GA(NF)  GRADIENT OF THE APPROXIMATED FUNCTION.
!  RO  G(NF)  GRADIENT OF THE OBJECTIVE FUNCTION.
!  RA  GO(NF)  AUXILIARY VECTOR.
!  RU  HA(MB)  HESSIAN MATRIX OF THE APPROXIMATED FUNCTION.
!  RO  H(M)  SPARSE HESSIAN MATRIX OF THE OBJECTIVE FUNCTION.
!  II  IH(NF+1)  POINTERS OF THE DIAGONAL ELEMENTS OF H.
!  II  JH(M)  INDICES OF THE NONZERO ELEMENTS OF H.
!  RI  IAG(NA+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
!  RI  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
!  RO  AF(NA)  VECTOR CONTAINING VALUES OF THE APPROXIMATED
!         FUNCTIONS.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RI  ETA1  PRECISION OF THE COMPUTED FUNCTION VALUES.
!  II  KBF  TYPE OF BOUNDS. KBF=0-BOUNDS ARE NOT USED. KBF=1-ONE SIDED
!         BOUNDS. KBF=2-TWO SIDED BOUNDS.
!  II  KD  DEGREE OF REQUIRED DERVATIVES.
!  IO  LD  DEGREE OF PREVIOUSLY COMPUTED DERIVATIVES.
!  IU  NFV  NUMBER OF OBJECTIVE FUNCTION VALUES COMPUTED.
!  IU  NFG  NUMBER OF OBJECTIVE FUNCTION GRADIENTS COMPUTED.
!  IU  IDECF  DECOMPOSITION INDICATOR. IDECF=0-NO DECOMPOSITION.
!
! SUBPROGRAMS USED :
!  SE  FUN  COMPUTATION OF THE VALUE OF THE APPROXIMATED FUNCTION.
!  SE  DFUN  COMPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION.
!  S   MXVSET  INITIATION OF A VECTOR.
!  S   PA1HS3  NUMERICAL COMPUTATION OF THE PARTIAL HESSIAN MATRIX.
!  S   PASSH2  ADDITION OF THE PARTIAL HESSIAN MATRIX TO THE SPARSE
!         HESSIAN MATRIX.
!
      SUBROUTINE PA2SF4 (NF, NA, X, IX, GA, G, GO, HA, H, IH, JH, IAG,
     &JAG, AF, F, ETA1, KBF, KD, LD, NFV, NFG, IDECF)
      INTEGER NF,NA,IX(*),IH(*),JH(*),IAG(*),JAG(*),KBF,KD,LD,NFV,NFG,
     &IDECF
      DOUBLE PRECISION X(*),GA(*),G(*),GO(*),HA(*),H(*),AF(*),F,ETA1
      DOUBLE PRECISION FA
      INTEGER J,JP,K,KA,L,NAG
      IF (KD.LE.LD) RETURN
      IF (KD.GE.0.AND.LD.LT.0) THEN
        F=0.0D0
        NFV=NFV+1
      END IF
      IF (KD.GE.1.AND.LD.LT.1) THEN
        CALL MXVSET (NF, 0.0D0, G)
        NFG=NFG+1
      END IF
      IF (KD.GE.2.AND.LD.LT.2) CALL MXVSET (IH(NF+1)-1, 0.0D0, H)
      NAG=0
      DO 20 KA=1,NA
        IF (KD.LT.0) GO TO 20
        IF (LD.LT.0) THEN
          CALL FUN (NF, KA, X, FA)
          F=F+FA
          AF(KA)=FA
        ELSE
          FA=AF(KA)
        END IF
        IF (KD.LT.1) GO TO 20
        CALL DFUN (NF, KA, X, GA)
        IF (LD.LT.1) THEN
          K=IAG(KA)
          L=IAG(KA+1)-K
          DO 10 J=1,L
            JP=ABS(JAG(K))
            G(JP)=G(JP)+GA(JP)
            K=K+1
   10     CONTINUE
        END IF
        IF (KD.LT.2) GO TO 20
        IDECF=0
        CALL PA1HS3 (NF, KA, X, IX, HA, GO, GA, IAG, JAG, FA, ETA1, KBF,
     &    NAG)
        CALL PASSH2 (H, IH, JH, HA, IAG, JAG, KA, 1.0D0)
   20 CONTINUE
      NFG=NFG+NAG/NA
      LD=KD
      RETURN
      END
! SUBROUTINE PA2SQ4             ALL SYSTEMS                97/12/01
! PURPOSE :
!  COMPUTATION OF THE VALUE AND THE GRADIENT AND THE HESSIAN MATRIX
!  OF THE OBJECTIVE FUNCTION WHICH IS DEFINED AS A SUM OF SQUARES.
!
! PARAMETERS:
!  II  NF  NUMBER OF VARIABLES.
!  II  NA  NUMBER OF APPROXIMATED FUNCTIONS.
!  RI  X(NF)  VECTOR OF VARIABLES.
!  RU  GA(NF)  GRADIENT OF THE APPROXIMATED FUNCTION.
!  RO  AG(MA)  SPARSE JACOBIAN MATRIX.
!  RO  G(NF)  GRADIENT OF THE OBJECTIVE FUNCTION.
!  RO  H(M)  SPARSE HESSIAN MATRIX OF THE OBJECTIVE FUNCTION.
!  II  IH(NF+1)  POINTERS OF THE DIAGONAL ELEMENTS OF H.
!  II  JH(M)  INDICES OF THE NONZERO ELEMENTS OF H.
!  RI  IAG(NA+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
!  RI  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
!  RI  AF(NA)  VECTOR CONTAINING VALUES OF THE APPROXIMATED
!         FUNCTIONS.
!  RI  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RI  ETA1  PRECISION OF THE COMPUTED FUNCTION VALUES.
!  II  KD  DEGREE OF REQUIRED DERIVATIVES.
!  IO  LD  DEGREE OF PREVIOUSLY COMPUTED DERIVATIVES.
!  II  ISNA  SAVING SPECIFICATION. ISNA=0-NO SAVING. ISNA=1-FUNCTION
!         VALUES ARE SAVED. ISNA=2-FUNCTION VALUES AND GRADIENTS ARE
!         SAVED.
!  IU  NFV  NUMBER OF OBJECTIVE FUNCTION VALUES COMPUTED.
!  IU  NFG  NUMBER OF OBJECTIVE FUNCTION GRADIENTS COMPUTED.
!  II  IDER  DEGREE OF ANALYTICALLY COMPUTED DERIVATIVES (0 OR 1).
!  IU  IDECF  DECOMPOSITION INDICATOR. IDECF=0-NO DECOMPOSITION.
!
! SUBPROGRAMS USED :
!  SE  FUN  COMPUTATION OF THE VALUE OF THE APPROXIMATED FUNCTION.
!  SE  DFUN  COMPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION.
!  S   MXVSET  INITIATION OF A VECTOR.
!  S   PASSH1  ADDITION OF THE PARTIAL GAUSS-NEWTON TERM TO THE SPARSE
!         HESSIAN MATRIX.
!
      SUBROUTINE PA2SQ4 (NF, NA, X, GA, AG, G, H, IH, JH, IAG, JAG, AF,
     &F, ETA1, KD, LD, ISNA, NFV, NFG, IDER, IDECF)
      INTEGER NF,NA,IH(*),JH(*),IAG(*),JAG(*),KD,LD,ISNA,NFV,NFG,IDER,
     &IDECF
      DOUBLE PRECISION X(*),GA(*),AG(*),G(*),H(*),AF(*),F,ETA1
      INTEGER J,JP,K,KA,L,NAV
      DOUBLE PRECISION FA
      IF (KD.LE.LD) RETURN
      IF (KD.GE.0.AND.LD.LT.0) THEN
        F=0.0D0
        NFV=NFV+1
      END IF
      IF (KD.GE.1.AND.LD.LT.1) THEN
        CALL MXVSET (NF, 0.0D0, G)
        IF (IDER.GT.0) NFG=NFG+1
      END IF
      IF (KD.GE.2.AND.LD.LT.2) CALL MXVSET (IH(NF+1)-1, 0.0D0, H)
      NAV=0
      DO 30 KA=1,NA
        IF (KD.LT.0) GO TO 30
        IF (LD.LT.0) THEN
          CALL FUN (NF, KA, X, FA)
          F=F+FA*FA
          AF(KA)=FA
        ELSE
          FA=AF(KA)
        END IF
        IF (KD.LT.1) GO TO 30
        IF (IDER.EQ.0) THEN
          CALL PA0GS3 (NF, KA, X, FA, GA, IAG, JAG, ETA1, NAV)
        ELSE
          CALL DFUN (NF, KA, X, GA)
        END IF
        IF (LD.GE.1) GO TO 20
        K=IAG(KA)
        L=IAG(KA+1)-K
        DO 10 J=1,L
          JP=ABS(JAG(K))
          G(JP)=G(JP)+FA*GA(JP)
          IF (ISNA.GT.1) AG(K)=GA(JP)
          K=K+1
   10   CONTINUE
   20   IF (KD.LT.2) GO TO 30
        IDECF=0
        CALL PASSH1 (H, IH, JH, IAG, JAG, GA, KA, 1.0D0)
   30 CONTINUE
      IF (KD.GE.0.AND.LD.LT.0) F=5.0D-1*F
      IF (IDER.EQ.0) NFV=NFV+NAV/NA
      LD=KD
      RETURN
      END
! SUBROUTINE PA2SQ8             ALL SYSTEMS                97/12/01
! PURPOSE :
!  COMPUTATION OF THE VALUE AND THE GRADIENT AND THE HESSIAN MATRIX
!  OF THE OBJECTIVE FUNCTION WHICH IS DEFINED AS A SUM OF SQUARES.
!
! PARAMETERS:
!  II  NF  NUMBER OF VARIABLES.
!  II  NA  NUMBER OF APPROXIMATED FUNCTIONS.
!  RI  X(NF)  VECTOR OF VARIABLES.
!  II  IX(NF)  VECTOR CONTAINING TYPES OF BOUNDS.
!  RU  GA(NF)  GRADIENT OF THE APPROXIMATED FUNCTION.
!  RO  G(NF)  GRADIENT OF THE OBJECTIVE FUNCTION.
!  RA  GO(NF)  AUXILIARY VECTOR.
!  RA  GS(NF)  AUXILIARY VECTOR.
!  RU  HA(ME)  HESSIAN MATRIX OF THE APPROXIMATED FUNCTION.
!  RO  H(M)  SPARSE HESSIAN MATRIX OF THE OBJECTIVE FUNCTION.
!  II  IH(NF+1)  POINTERS OF THE DIAGONAL ELEMENTS OF H.
!  II  JH(M)  INDICES OF THE NONZERO ELEMENTS OF H.
!  RI  IAG(NA+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
!  RI  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
!  RO  AF(NA)  VECTOR CONTAINING VALUES OF THE APPROXIMATED
!         FUNCTIONS.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RI  ETA1  PRECISION OF THE COMPUTED FUNCTION VALUES.
!  II  KBF  TYPE OF BOUNDS. KBF=0-BOUNDS ARE NOT USED. KBF=1-ONE SIDED
!         BOUNDS. KBF=2-TWO SIDED BOUNDS.
!  II  KD  DEGREE OF REQUIRED DERIVATIVES.
!  IO  LD  DEGREE OF PREVIOUSLY COMPUTED DERIVATIVES.
!  IU  NFV  NUMBER OF OBJECTIVE FUNCTION VALUES COMPUTED.
!  IU  NFG  NUMBER OF OBJECTIVE FUNCTION GRADIENTS COMPUTED.
!  II  IPOM1  CORRECTION OPTION. IPOM1=0-THE NEWTON CORRECTION IS USED.
!         IPOM1=1-CORRECTION IS NOT USED.
!  II  IDER  DEGREE OF ANALYTICALLY COMPUTED DERIVATIVES (0 OR 1).
!  IU  IDECF  DECOMPOSITION INDICATOR. IDECF=0-NO DECOMPOSITION.
!
! SUBPROGRAMS USED :
!  SE  FUN  COMPUTATION OF THE VALUE OF THE APPROXIMATED FUNCTION.
!  SE  DFUN  COMPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION.
!  S   MXVSET  INITIATION OF A VECTOR.
!  S   PA0HS3  NUMERICAL COMPUTATION OF THE PARTIAL HESSIAN MATRIX.
!  S   PA1HS3  NUMERICAL COMPUTATION OF THE PARTIAL HESSIAN MATRIX.
!  S   PASSH1  ADDITION OF THE PARTIAL GAUSS-NEWTON TERM TO THE SPARSE
!         HESSIAN MATRIX.
!  S   PASSH2  ADDITION OF THE PARTIAL HESSIAN MATRIX TO THE SPARSE
!         HESSIAN MATRIX.
!
      SUBROUTINE PA2SQ8 (NF, NA, X, IX, GA, G, GO, GS, HA, H, IH, JH,
     &IAG, JAG, AF, F, ETA1, KBF, KD, LD, NFV, NFG, IPOM1, IDER, IDECF)
      INTEGER NF,NA,IX(*),IH(*),JH(*),IAG(*),JAG(*),KBF,KD,LD,NFV,NFG,
     &IPOM1,IDER,IDECF
      DOUBLE PRECISION X(*),GA(*),G(*),GO(*),GS(*),HA(*),H(*),AF(*),F,
     &ETA1
      INTEGER J,JP,K,KA,L,NAV,NAG
      DOUBLE PRECISION FA
      IF (KD.LE.LD) RETURN
      IF (KD.GE.0.AND.LD.LT.0) THEN
        F=0.0D0
        NFV=NFV+1
      END IF
      IF (KD.GE.1.AND.LD.LT.1) THEN
        CALL MXVSET (NF, 0.0D0, G)
        IF (IDER.GT.0) NFG=NFG+1
      END IF
      IF (KD.GE.2.AND.LD.LT.2) CALL MXVSET (IH(NF+1)-1, 0.0D0, H)
      NAV=0
      NAG=0
      DO 20 KA=1,NA
        IF (KD.LT.0) GO TO 20
        IF (LD.LT.0) THEN
          CALL FUN (NF, KA, X, FA)
          F=F+FA*FA
          AF(KA)=FA
        ELSE
          FA=AF(KA)
        END IF
        IF (KD.LT.1) GO TO 20
        IF (IDER.EQ.0) THEN
          CALL PA0GS3 (NF, KA, X, FA, GA, IAG, JAG, ETA1, NAV)
        ELSE
          CALL DFUN (NF, KA, X, GA)
        END IF
        IF (LD.LT.1) THEN
          K=IAG(KA)
          L=IAG(KA+1)-K
          DO 10 J=1,L
            JP=ABS(JAG(K))
            G(JP)=G(JP)+FA*GA(JP)
            K=K+1
   10     CONTINUE
        END IF
        IF (KD.LT.2) GO TO 20
        IDECF=0
        IF (IPOM1.EQ.0) THEN
          IF (IDER.EQ.0) THEN
            CALL PA0HS3 (NF, KA, X, IX, HA, GO, GS, IAG, JAG, FA, ETA1,
     &       KBF, NAV)
          ELSE
            CALL PA1HS3 (NF, KA, X, IX, HA, GO, GA, IAG, JAG, FA, ETA1,
     &       KBF, NAG)
          END IF
        END IF
        CALL PASSH1 (H, IH, JH, IAG, JAG, GA, KA, 1.0D0)
        IF (IPOM1.EQ.0) CALL PASSH2 (H, IH, JH, HA, IAG, JAG, KA, FA)
   20 CONTINUE
      IF (KD.GE.0.AND.LD.LT.0) F=5.0D-1*F
      IF (IDER.EQ.0) NFV=NFV+NAV/NA
      IF (IDER.GT.0) NFG=NFG+NAG/NA
      LD=KD
      RETURN
      END
! SUBROUTINE PALNG3             ALL SYSTEMS                   97/12/01
! PURPOSE :
! COMPUTATION OF THE GRADIENT OF THE LINEAR APPROXIMATED FUNCTION.
!
! PARAMETERS :
!  RO  AG(MA)  SPARSE JACOBIAN MATRIX.
!  RI  IAG(NA+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
!  RI  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
!  RO  GA(NF)  GRADIENT OF THE APPROXIMATED FUNCTION.
!  II  KA  INDEX OF THE SELECTED FUNCTION.
!
      SUBROUTINE PALNG3 (AG, IAG, JAG, GA, KA)
      DOUBLE PRECISION AG(*),GA(*)
      INTEGER IAG(*),JAG(*),KA
      INTEGER J,JP,K,L
      K=IAG(KA)
      L=IAG(KA+1)-K
      DO 10 J=1,L
        JP=ABS(JAG(K))
        GA(JP)=AG(K)
        K=K+1
   10 CONTINUE
      RETURN
      END
! SUBROUTINE PASED3             ALL SYSTEMS                   07/12/01
! PURPOSE :
! COMPRESSED SPARSE STRUCTURE OF THE JACOBIAN MATRIX IS COMPUTED FROM
! THE COORDINATE FORM.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  II  NA  NUMBER OF APPROXIMATED FUNCTIONS.
!  II  MA  NUMBER OF NONZERO ELEMENTS IN THE SPARSE JACOBIAN MATRIX.
!  IU  IAG(MA+NA)  ON INPUT ROW INDICES OF NONZERO ELEMENTS IN THE FIELD
!          ON OUTPUT POSITIONS OF THE FIRST ROW ELEMENTS IN THE FIELD AG
!  II  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
!  IO  IER  ERROR MESAGE. IER=0-THE STANDARD INPUT DATA ARE CORRECT.
!         IER=1-ERROR IN THE ARRAY IAG. IER=2-ERROR IN THE ARRAY JAG.
!
      SUBROUTINE PASED3 (NF, NA, MA, IAG, JAG, IER)
      INTEGER NF,NA,MA,IAG(*),JAG(*),IER
      INTEGER I,J,K,L,KA
      IER=0
      CALL MXVSR7 (MA, IAG, JAG)
      IF (IAG(1).LT.1.OR.IAG(MA).GT.NA) THEN
        IER=1
        RETURN
      END IF
      CALL MXVINS (NA, 0, IAG(MA+1))
      DO 10 J=1,MA
        IAG(IAG(J)+MA)=IAG(IAG(J)+MA)+1
   10 CONTINUE
      IAG(1)=1
      DO 20 KA=1,NA
        IAG(KA+1)=IAG(KA)+IAG(KA+MA)
   20 CONTINUE
      I=0
      DO 40 KA=1,NA
        K=IAG(KA)
        L=IAG(KA+1)-K
        IF (L.GT.0) THEN
          CALL MXVSRT (L, JAG(K))
          IF (JAG(K).LT.1.OR.JAG(K+L-1).GT.NF) THEN
            IER=2
            RETURN
          END IF
        END IF
        IAG(KA)=IAG(KA)-I
        DO 30 J=1,L
          IF (J.GT.1.AND.JAG(K).EQ.JAG(K-1)) THEN
            I=I+1
          ELSE
            JAG(K-I)=JAG(K)
          END IF
          K=K+1
   30   CONTINUE
   40 CONTINUE
      IAG(NA+1)=IAG(NA+1)-I
      MA=IAG(NA+1)-1
      RETURN
      END
! SUBROUTINE PASSH1             ALL SYSTEMS                   98/12/01
! PURPOSE :
! COMPUTATION OF THE SPARSE HESSIAN MATRIX FROM THE SPARSE JACOBIAN
! MATRIX.
!
! PARAMETERS :
!  RU  H(M)  NONZERO ELEMENTS OF THE SPARSE HESSIAN MATRIX.
!  II  IH(NF+1)  POINTERS OF THE DIAGONAL ELEMENTS OF H.
!  II  JH(M)  COLUMN INDICES OF THE NONZERO ELEMENTS OF H.
!  II  IAG(NA+1)  POSITIONS OF THE FIRST ROWS ELEMENTS IN THE SPARSE
!         JACOBIAN STRUCTURE.
!  II  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE SPARSE JACOBIAN
!         STRUCTURE.
!  RI  GA(NF)  GRADIENT OF THE SELECTED FUNCTION.
!  II  KA  INDEX OF THE SELECTED FUNCTION (ROW OF THE SPARSE JACOBIAN
!         MATRIX).
!  RI  FACTOR  SCALING FACTOR.
!
      SUBROUTINE PASSH1 (H, IH, JH, IAG, JAG, GA, KA, FACTOR)
      INTEGER IH(*),JH(*),IAG(*),JAG(*),KA
      DOUBLE PRECISION H(*),GA(*),FACTOR
      DOUBLE PRECISION TEMP
      INTEGER I,J,JF,JA,K,LA
      LA=IAG(KA+1)-1
      DO 30 K=IAG(KA),LA
        I=ABS(JAG(K))
        TEMP=FACTOR*GA(I)
        JF=IH(I)
        DO 20 JA=K,LA
          J=ABS(JAG(JA))
   10     IF (ABS(JH(JF)).LT.J) THEN
            JF=JF+1
            GO TO 10
          END IF
          H(JF)=H(JF)+TEMP*GA(J)
   20   CONTINUE
   30 CONTINUE
      RETURN
      END
! SUBROUTINE PASSH2             ALL SYSTEMS                   98/12/01
! PURPOSE :
! COMPUTATION OF THE SPARSE HESSIAN MATRIX FROM THE SPARSE JACOBIAN
! MATRIX.
!
! PARAMETERS :
!  RU  H(M)  NONZERO ELEMENTS OF THE SPARSE HESSIAN MATRIX.
!  II  IH(NF+1)  POINTERS OF THE DIAGONAL ELEMENTS OF H.
!  II  JH(M)  COLUMN INDICES OF THE NONZERO ELEMENTS OF H.
!  II  HA(ME)  PACKED HESSIAN MATRIX OF THE SELECTED FUNCTION.
!  II  IAG(NA+1)  POSITIONS OF THE FIRST ROWS ELEMENTS IN THE SPARSE
!         JACOBIAN STRUCTURE.
!  II  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE SPARSE JACOBIAN
!         STRUCTURE.
!  II  KA  INDEX OF THE SELECTED FUNCTION (ROW OF THE SPARSE JACOBIAN
!         MATRIX).
!  RI  FACTOR  SCALING FACTOR.
!
      SUBROUTINE PASSH2 (H, IH, JH, HA, IAG, JAG, KA, FACTOR)
      INTEGER IH(*),JH(*),IAG(*),JAG(*),KA
      DOUBLE PRECISION H(*),HA(*),FACTOR
      INTEGER I,II,IA,J,JJ,JA,JF,K,KK,L
      KK=0
      II=IAG(KA)
      L=IAG(KA+1)-II
      DO 30 IA=1,L
        KK=KK+IA
        I=ABS(JAG(II))
        JF=IH(I)
        JJ=II
        K=KK
        DO 20 JA=IA,L
          J=ABS(JAG(JJ))
   10     IF (ABS(JH(JF)).LT.J) THEN
            JF=JF+1
            GO TO 10
          END IF
          H(JF)=H(JF)+FACTOR*HA(K)
          K=K+JA
          JJ=JJ+1
   20   CONTINUE
        II=II+1
   30 CONTINUE
      RETURN
      END
! SUBROUTINE PASSH3             ALL SYSTEMS                   98/12/01
! PURPOSE :
! COMPUTATION OF THE SPARSE HESSIAN MATRIX FROM THE SPARSE JACOBIAN
! MATRIX.
!
! PARAMETERS :
!  RU  H(M)  NONZERO ELEMENTS OF THE SPARSE HESSIAN MATRIX.
!  II  IH(NF+1)  POINTERS OF THE DIAGONAL ELEMENTS OF H.
!  II  JH(M)  COLUMN INDICES OF THE NONZERO ELEMENTS OF H.
!  II  IAG(NA+1)  POSITIONS OF THE FIRST ROWS ELEMENTS IN THE SPARSE
!         JACOBIAN STRUCTURE.
!  II  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE SPARSE JACOBIAN
!         STRUCTURE.
!  RI  GA(NF)  GRADIENT OF THE SELECTED FUNCTION.
!  II  KA  INDEX OF THE SELECTED FUNCTION (ROW OF THE SPARSE JACOBIAN
!         MATRIX).
!  RI  FACTOR  SCALING FACTOR.
!
      SUBROUTINE PASSH3 (H, IH, JH, IAG, JAG, GA, KA, FACTOR)
      INTEGER IH(*),JH(*),IAG(*),JAG(*),KA
      DOUBLE PRECISION H(*),GA(*),FACTOR
      DOUBLE PRECISION TEMP
      INTEGER I,J,JF,JA,K,LA
      LA=IAG(KA+1)-1
      DO 30 K=IAG(KA),LA
        I=ABS(JAG(K))
        IF (I.LE.0) GO TO 30
        TEMP=FACTOR*GA(I)
        JF=IH(I)
        DO 20 JA=K,LA
          J=ABS(JAG(JA))
          IF (J.LE.0) GO TO 20
   10     IF (ABS(JH(JF)).LT.J) THEN
            JF=JF+1
            GO TO 10
          END IF
          H(JF)=H(JF)+TEMP*GA(J)
   20   CONTINUE
   30 CONTINUE
      RETURN
      END
! SUBROUTINE PCBS04             ALL SYSTEMS                   98/12/01
! PURPOSE :
! INITIATION OF THE VECTOR CONTAINING TYPES OF CONSTRAINTS.
!
! 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  EPS9  TOLERANCE FOR ACTIVE CONSTRAINTS.
!  II  KBF  SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS.
!         KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS.
!
      SUBROUTINE PCBS04 (NF, X, IX, XL, XU, EPS9, KBF)
      INTEGER NF,IX(*),KBF
      DOUBLE PRECISION X(*),XL(*),XU(*),EPS9
      DOUBLE PRECISION TEMP
      INTEGER I,IXI
      IF (KBF.GT.0) THEN
        DO 10 I=1,NF
          TEMP=1.0D0
          IXI=ABS(IX(I))
          IF ((IXI.EQ.1.OR.IXI.EQ.3.OR.IXI.EQ.4).AND.X(I).LE.XL(I)+EPS9*
     &     MAX(ABS(XL(I)),TEMP)) X(I)=XL(I)
          IF ((IXI.EQ.2.OR.IXI.EQ.3.OR.IXI.EQ.4).AND.X(I).GE.XU(I)-EPS9*
     &     MAX(ABS(XU(I)),TEMP)) X(I)=XU(I)
   10   CONTINUE
      END IF
      RETURN
      END
! SUBROUTINE PDSGM1               ALL SYSTEMS                 01/09/22
! PURPOSE :
! COMPUTATION OF A TRUST-REGION STEP BY THE DOG-LEG METHOD WITH DIRECT
! MATRIX DECOMPOSITIONS.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  II  MMAX  MAXIMUM DIMENSION OF THE SPARSE TABLEAU.
!  II  MH  POINTER OBTAINED BY THE SUBROUTINE MXSPCC.
!  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.
!  RO  G(NF)  GRADIENT OF THE OBJECTIVE FUNCTION.
!  RA  H(MMAX)  NONZERO ELEMENTS OF THE APPROXIMATION OF THE SPARSE
!         HESSIAN MATRIX TOGETHER WITH AN ADDITIONAL SPACE USED FOR
!         THE NUMERICAL DIFFERENTIATION.
!  II  IH(NF+1)  POINTERS OF DIAGONAL ELEMENTS OF THE MATRIX H.
!  IU  JH(MMAX)  INDICES OF NONZERO ELEMENTS OF THE MATRIX H
!         TOGETHER WITH AN ADDITIONAL SPACE USED FOR THE NUMERICAL
!         DIFFERENTIATION.
!  RO  S(NF)  DIRECTION VECTOR.
!  RU  XO(NF)  VECTORS OF VARIABLES DIFFERENCE.
!  RI  GO(NF)  GRADIENTS DIFFERENCE.
!  RA  XS(NF)  AUXILIARY VECTOR.
!  II  PSL(NF+1)  POINTER VECTOR OF THE COMPACT FORM OF THE TRIANGULAR
!         FACTOR OF THE HESSIAN APPROXIMATION.
!  IA  PERM(NF)  PERMUTATION VECTOR.
!  IA  WN11(NF+1) AUXILIARY VECTOR.
!  IA  WN12(NF+1) AUXILIARY VECTOR.
!  RI  XMAX  MAXIMUM STEPSIZE.
!  RU  XDEL  TRUST REGION RADIUS.
!  RO  GNORM  NORM OF THE GRADIENT VECTOR.
!  RO  SNORM  NORM OF THE DIRECTION VECTOR.
!  RI  FMIN  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!  RI  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RO  P  VALUE OF THE DIRECTIONAL DERIVATIVE.
!  RO  PP  VALUE OF THE QUADRATIC TERM.
!  RI  ETA2  TOLERANCE FOR POSITIVE DEFINITENESS.
!  RI  ALF2  TOLERANCE FOR THE GRADIENT NORM.
!  II  KD  ORDER OF COMPUTED DERIVATIVES.
!  II  KBF  SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS.
!         KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS.
!  II  IEST  ESTIMATION INDICATOR. IEST=0-MINIMUM IS NOT ESTIMATED.
!         IEST=1-MINIMUM IS ESTIMATED BY THE VALUE FMIN.
!  IU  IDEC  DECOMPOSITION INDICATOR. IDEC=0-NO DECOMPOSITION.
!  IU  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  II  ITERD  CAUSE OF TERMINATION IN THE DIRECTION DETERMINATION.
!         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  ITERM  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=3-IF F WAS LESS THAN OR EQUAL TO TOLB.
!         ITERM=4-IF GMAX WAS LESS THAN OR EQUAL TO TOLG.
!         ITERM=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!         VALUES ITERM<=-40 DETECT A LACK OF SPACE.
!
! SUBPROGRAMS USED :
!  S   PNSTEP  COMPUTATION OF THE BOUNDARY STEP.
!  S   MXSPCB  BACK SUBSTITUTION USING THE SPARSE DECOMPOSITION
!         OBTAINED BY MXSPCF.
!  S   MXSPCD  COMPUTATION OF A DIRECTION OF NEGATIVE CURVATURE USING
!         THE SPARSE DECOMPOSITION OBTAINED BY MXSPCF.
!  S   MXSPCF  GILL-MURRAY DECOMPOSITION OD A SPARSE SYMMETRIC MATRIX.
!  S   MXSPCM  MATRIX-VECTOR PRODUCT USING THE SPARSE DECOMPOSITION
!         OBTAINED BY MXSPCF.
!  RF  MXSPCQ  GENERALIZED DOT PRODUCT USING THE SPARSE DECOMPOSITION
!         OBTAINED BY MXSPCF.
!  S   MXSPCT  COPYING A SPARSE SYMMETRIC MATRIX INTO THE PERMUTED
!         FACTORIZED COMPACT SCHEME.
!  RF  MXSSMQ  COMPUTATION OF THE SPARSE QUADRATIC TERM.
!  S   MXUCOP  COPYING OF A VECTOR.
!  S   MXUDIF  DIFFERENCE OF TWO VECTORS.
!  S   MXUDIR  VECTOR AUGMENTED BY THE SCALED VECTOR.
!  RF  MXUDOT  DOT PRODUCT OF TWO VECTORS.
!  S   MXUNEG  COPYING OF A VECTOR WITH CHANGE OF THE SIGN.
!  S   MXVSBP  INVERSE PERMUTATION OF A VECTOR
!  S   MXVSCL  SCALING OF A VECTOR.
!  S   MXVSET  INITIATION OF A VECTOR.
!  S   MXVSFP  PERMUTATION OF A VECTOR.
!
! METHOD :
! J.E.DENNIS, H.H.W.MEI: AN UNCONSTRAINED OPTIMIZATION ALGORITHM WHICH
! USES FUNCTION AND GRADIENT VALUES. REPORT NO. TR-75-246, DEPT. OF
! COMPUTER SCIENCE, CORNELL UNIVERSITY 1975.
!
      SUBROUTINE PDSGM1 (NF, MMAX, MH, IX, G, H, IH, JH, S, XO, GO, XS,
     &PSL, PERM, WN11, WN12, XMAX, XDEL, GNORM, SNORM, FMIN, F, P, PP,
     &ETA2, ALF2, KD, KBF, IEST, IDEC, NDEC, ITERD, ITERM)
      INTEGER NF,MMAX,MH,IX(*),IH(*),JH(*),PSL(*),PERM(*),WN11(*),WN12(*
     &),KD,KBF,IEST,IDEC,NDEC,ITERD,ITERM
      DOUBLE PRECISION G(*),H(*),S(*),XO(*),GO(*),XS(*),XMAX,XDEL,GNORM,
     &SNORM,FMIN,F,P,PP,ETA2,ALF2
      INTEGER MM,INF,MODE
      DOUBLE PRECISION B1,B2,B3,D3,S1,S2
      DOUBLE PRECISION MXSSMQ,MXSPCQ,MXUDOT
      SAVE  INF
!
!     DIRECTION DETERMINATION
!
      IF (IDEC.LT.0) IDEC=0
      IF (IDEC.EQ.0) THEN
      ELSE IF (IDEC.EQ.1) THEN
      ELSE
        ITERD=-1
        GO TO 20
      END IF
      MM=IH(NF+1)-1
      B2=MXUDOT(NF,G,G,IX,KBF)
      GNORM=SQRT(B2)
      MODE=1
      IF (ALF2*GNORM.LE.XDEL) THEN
        MODE=2
        IF (IDEC.EQ.0) THEN
          CALL MXSPCT (NF, MM, MH, MMAX, H, JH, PSL, ITERM)
          IF (ITERM.NE.0) GO TO 20
!
!     SPARSE GILL-MURRAY DECOMPOSITION
!
          S1=ETA2
          CALL MXSPCF (NF, H(MM+1), PSL, JH(MM+1), WN11, WN12, XS, INF,
     &     S1, S2)
          NDEC=NDEC+1
          IDEC=1
        END IF
        IF (INF.GT.0) THEN
          CALL MXSPCD (NF, H(MM+1), PSL, JH(MM+1), S, INF)
          CALL MXVSBP (NF, PERM, S, XS)
!
!     DIRECTION OF NEGATIVE CURVATURE
!
          SNORM=SQRT(MXUDOT(NF,S,S,IX,KBF))
          IF (SNORM*SNORM*GNORM+S1*XDEL.LE.0.0D0) THEN
            CALL MXVSCL (NF, XDEL/SNORM, S, S)
            SNORM=XDEL
            ITERD=4
            GO TO 10
          END IF
        ELSE IF (GNORM.LE.0.0D0) THEN
!
!     ZERO DIRECTION
!
          SNORM=0.0D0
          CALL MXVSET (NF, 0.0D0, S)
          GO TO 10
        END IF
      END IF
      IF (IDEC.EQ.0) THEN
        B1=MXSSMQ(NF,H,IH,JH,G,G)
      ELSE
        CALL MXUCOP (NF, G, GO, IX, KBF)
        CALL MXVSFP (NF, PERM, GO, XS)
        CALL MXSPCM (NF, H(MM+1), PSL, JH(MM+1), GO, XS, 1)
        B1=MXSPCQ(NF,H(MM+1),PSL,GO)
      END IF
      IF (XDEL.LE.0.0D0) THEN
!
!     INITIAL TRUST REGION BOUND
!
        IF (B1.LE.0.0D0) THEN
          XDEL=GNORM
        ELSE
          XDEL=(B2/B1)*GNORM
        END IF
        IF (IEST.EQ.1) XDEL=MIN(XDEL,4.0D0*(F-FMIN)/GNORM)
        XDEL=MIN(XDEL,XMAX)
      END IF
      IF (B1.LE.0.0D0.OR.B2*GNORM.GE.B1*XDEL) THEN
!
!     SCALED STEEPEST DESCENT DIRECTION IS ACCEPTED
!
        CALL MXVSCL (NF, -XDEL/GNORM, G, S)
        SNORM=XDEL
        ITERD=3
        GO TO 10
      END IF
      IF (IDEC.EQ.0) THEN
        CALL MXSPCT (NF, MM, MH, MMAX, H, JH, PSL, ITERM)
        IF (ITERM.NE.0) THEN
          GO TO 20
        END IF
!
!     SPARSE GILL-MURRAY DECOMPOSITION
!
        S1=ETA2
        CALL MXSPCF (NF, H(MM+1), PSL, JH(MM+1), WN11, WN12, XS, INF,
     &   S1, S2)
        NDEC=NDEC+1
        IDEC=1
      END IF
!
!     COMPUTATION OF THE NEWTON DIRECTION
!
      CALL MXUCOP (NF, G, GO, IX, KBF)
      CALL MXVSFP (NF, PERM, GO, XS)
      CALL MXSPCB (NF, H(MM+1), PSL, JH(MM+1), GO, 0)
      CALL MXVSBP (NF, PERM, GO, XS)
      D3=SQRT(MXUDOT(NF,GO,GO,IX,KBF))
!
!     COMPUTATION OF THE STEEPEST DESCENT DIRECTION
!
      B2=B2/B1
      SNORM=B2*GNORM
      CALL MXVSCL (NF, -B2, G, S)
      CALL MXUNEG (NF, GO, GO, IX, KBF)
      CALL MXUDIF (NF, GO, S, XO, IX, KBF)
      B1=MXUDOT(NF,S,XO,IX,KBF)
      B2=MXUDOT(NF,XO,XO,IX,KBF)
      IF (B2.LE.1.0D-8*XDEL*XDEL) THEN
!
!     NEWTON AND THE STEEPEST DESCENT DIRECTION ARE
!     APPROXIMATELY EQUAL
!
        CALL MXUCOP (NF, GO, S, IX, KBF)
        SNORM=D3
        ITERD=1
      ELSE IF (B1.LE.0.0D0) THEN
!
!     BOUNDARY STEP WITH NEGATIVE INCREMENT
!
        CALL PNSTEP (XDEL, SNORM, -B1, B2, B3)
        CALL MXUDIR (NF, -B3, XO, S, S, IX, KBF)
        SNORM=XDEL
        ITERD=3
      ELSE IF (D3.LE.XDEL) THEN
!
!     NEWTON DIRECTION IS ACCEPTED
!
        CALL MXUCOP (NF, GO, S, IX, KBF)
        SNORM=D3
        ITERD=1
      ELSE
!
!     DOUBLE DOGLEG STRATEGY
!
        D3=XDEL/D3
        B3=MXUDOT(NF,S,GO,IX,KBF)
        D3=MAX(D3,SNORM*SNORM/B3)
        CALL MXUDIR (NF, -D3, GO, S, XO, IX, KBF)
        B1=SNORM*SNORM-D3*B3
        B2=MXUDOT(NF,XO,XO,IX,KBF)
        CALL PNSTEP (XDEL, SNORM, -B1, B2, B3)
        CALL MXUDIR (NF, -B3, XO, S, S, IX, KBF)
        SNORM=XDEL
        ITERD=3
      END IF
   10 CONTINUE
      IF (IDEC.EQ.0) THEN
        PP=MXSSMQ(NF,H,IH,JH,S,S)*0.5D0
      ELSE
        CALL MXUCOP (NF, S, GO, IX, KBF)
        CALL MXVSFP (NF, PERM, GO, XS)
        CALL MXSPCM (NF, H(MM+1), PSL, JH(MM+1), GO, XS, 1)
        PP=MXSPCQ(NF,H(MM+1),PSL,GO)*0.5D0
        IF (ITERD.EQ.1.AND.INF.NE.0) ITERD=2
      END IF
   20 CONTINUE
      IF (KD.GT.0) P=MXUDOT(NF,G,S,IX,KBF)
      RETURN
      END
! SUBROUTINE PDSGM4               ALL SYSTEMS                 01/09/22
! PURPOSE :
! COMPUTATION OF A TRUST-REGION STEP BY THE SHIFTED STEIHAUG-TOINT
! METHOD WITH CONJUGATE GRADIENT ITERATIONS.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  II  MMAX  MAXIMUM DIMENSION OF THE SPARSE TABLEAU.
!  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.
!  RO  G(NF)  GRADIENT OF THE OBJECTIVE FUNCTION.
!  RA  H(MMAX)  NONZERO ELEMENTS OF THE APPROXIMATION OF THE SPARSE
!         HESSIAN MATRIX TOGETHER WITH AN ADDITIONAL SPACE USED FOR
!         THE NUMERICAL DIFFERENTIATION.
!  II  IH(NF+1)  POINTERS OF DIAGONAL ELEMENTS OF THE MATRIX H.
!  IU  JH(MMAX)  INDICES OF NONZERO ELEMENTS OF THE MATRIX H
!         TOGETHER WITH AN ADDITIONAL SPACE USED FOR THE NUMERICAL
!         DIFFERENTIATION.
!  RO  S(NF)  DIRECTION VECTOR.
!  RU  XO(NF)  VECTORS OF VARIABLES DIFFERENCE.
!  RI  GO(NF)  GRADIENTS DIFFERENCE.
!  RA  XS(NF)  AUXILIARY VECTOR.
!  RA  GS(NF)  AUXILIARY VECTOR.
!  IA  IW(NF+1)  AUXILIARY VECTOR.
!  RI  XMAX  MAXIMUM STEPSIZE.
!  RU  XDEL  TRUST REGION RADIUS.
!  RO  GNORM  NORM OF THE GRADIENT VECTOR.
!  RO  GNORMO  OLD NORM OF THE GRADIENT VECTOR.
!  RO  SNORM  NORM OF THE DIRECTION VECTOR.
!  RI  FMIN  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!  RI  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RO  P  VALUE OF THE DIRECTIONAL DERIVATIVE.
!  RO  PP  VALUE OF THE QUADRATIC TERM.
!  RI  ETA0  MACHINE PRECISION.
!  RI  ETA2  TOLERANCE FOR POSITIVE DEFINITENESS.
!  RI  DEL1  LOWER TOLERANCE FOR THE TRUST-REGION RADIUS.
!  II  KD  ORDER OF COMPUTED DERIVATIVES.
!  II  KBF  SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS.
!         KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS.
!  II  MOS1  NUMBER OF LANCZOS STEPS IN THE SHIFTED STEIHAUG-TOINT
!         METHOD.
!  II  MOS2  TYPE OF PRECONDITIONING. MOS2=1-PRECONDITIONING IS NOT
!         USED. MOS2=2-PRECONDITIONING BY THE INCOMPLETE GILL-MURRAY
!         DECOMPOSITION. MOS2=3-PRECONDITIONING BY THE INCOMPLETE
!         GILL-MURRAY DECOMPOSITION WITH A PRELIMINARY SOLUTION OF
!         THE PRECONDITIONED SYSTEM WHICH IS USED IF IT SATISFIES
!         THE TERMINATION CRITERION.
!  II  MOS3 PRECONDITIONING IN ILL-CONTITIONED AND INDEFINITE CASES.
!         MOS3=0-PRECONDITIONING IN BOTH THESE CASES IS SUPPRESSED.
!         MOS3=1-PRECONDITIONING IN ILL-CONDITIONED CASE IS SUPPRESSED.
!         MOS3=2-PRECONDITIONING IS ALWAYS USED.
!  II  IEST  ESTIMATION INDICATOR. IEST=0-MINIMUM IS NOT ESTIMATED.
!         IEST=1-MINIMUM IS ESTIMATED BY THE VALUE FMIN.
!  IU  IDEC  DECOMPOSITION INDICATOR. IDEC=0-NO DECOMPOSITION.
!  IU  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  II  NIT  NUMBER OF OUTER ITERATIONS.
!  IU  NIN NUMBER OF INNER CONJUGATE GRADIENT ITERATIONS.
!  II  ITERD  CAUSE OF TERMINATION IN THE DIRECTION DETERMINATION.
!         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  ITERM  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=3-IF F WAS LESS THAN OR EQUAL TO TOLB.
!         ITERM=4-IF GMAX WAS LESS THAN OR EQUAL TO TOLG.
!         ITERM=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!         VALUES ITERM<=-40 DETECT A LACK OF SPACE.
!
! SUBPROGRAMS USED :
!  S   PNSTEP  COMPUTATION OF THE BOUNDARY STEP.
!  S   MXSPTB  BACK SUBSTITUTION AFTER THE GILL-MURRAY DECOMPOSITION.
!  S   MXSPTF  INCOMPLETE GILL-MURRAY DECOMPOSITION.
!  S   MXSSDA  SPARSE SYMMETRIC MATRIX IS AUGMENTED BY THE SCALED UNIT
!         MATRIX.
!  S   MXSSMD  MATRIX-VECTOR PRODUCT FOLLOWED BY THE ADDITION OF A
!         SCALED VECTOR.
!  S   MXSSMM  MATRIX-VECTOR PRODUCT.
!  RF  MXSSMQ  COMPUTATION OF THE SPARSE QUADRATIC TERM.
!  S   MXTPGB  BACK SUBSTITUTION FOR A DECOMPOSED TRIDIAGONAL MATRIX.
!  S   MXTPGF  CHOLESKI DECOMPOSITION OF A TRIDIAGONAL MATRIX.
!  S   MXUDIR  VECTOR AUGMENTED BY THE SCALED VECTOR.
!  RF  MXUDEL  NORM OF VECTOR DIFFERENCE.
!  RF  MXUDOT  DOT PRODUCT OF TWO VECTORS.
!  RF  MXUNOR  EUCLIDEAN NORM OF A VECTOR.
!  S   MXVCOP  COPYING OF A VECTOR.
!  S   MXVCOR  CORRECTION OF A VECTOR (ZERO ELEMENTS ARE REPLACED BY
!         THE NONZERO NUMBER).
!  RF  MXVDOT  DOT PRODUCT OF TWO VECTORS.
!  S   MXVNEG  COPYING OF A VECTOR WITH CHANGE OF THE SIGN.
!  S   MXVSCL  SCALING OF A VECTOR.
!  S   MXVSET  INITIATION OF A VECTOR.
!  S   MXVSUM  SUM OF TWO VECTORS.
!  RF  MXVVDP  GENERALIZED DOT PRODUCT.
!
! METHOD :
! L.LUKSAN, C.MATONOHA, J.VLCEK: A SHIFTED STEIHAUG-TOINT METHOD FOR
! COMPUTING TRUST-REGION STEP. REPORT NO. V-914, INST. OF COMPUTER
! SCIENCE, CZECH ACADEMY OF SCIENCES, 2004.
!
      SUBROUTINE PDSGM4 (NF, MMAX, IX, G, H, IH, JH, S, XO, GO, XS, GS,
     &IW, XMAX, XDEL, GNORM, GNORMO, SNORM, FMIN, F, P, PP, ETA0, ETA2,
     &DEL1, KD, KBF, MOS1, MOS2, MOS3, IEST, IDEC, NDEC, NIT, NIN,
     &ITERD, ITERM)
      INTEGER NF,MMAX,IX(*),IH(*),JH(*),IW(*),KD,KBF,MOS1,MOS2,MOS3,
     &IEST,IDEC,NDEC,NIT,NIN,ITERD,ITERM
      DOUBLE PRECISION G(*),H(*),S(*),XO(*),GO(*),XS(*),GS(*),XMAX,XDEL,
     &GNORM,GNORMO,SNORM,FMIN,F,P,PP,ETA0,ETA2,DEL1
      INTEGER NOS1,NOS2,NRED,I,M,INF
      DOUBLE PRECISION T,EL,EU,PAR,ALF,EPS,RHO,RHO1,RHO2,SIG,TAU
      DOUBLE PRECISION MXSSMQ,MXUDOT,MXUDEL,MXUNOR,MXVDOT,MXVVDP
      SAVE  EPS
!
!     DIRECTION DETERMINATION
!
      IF (NIT.LE.1) THEN
        EPS=0.9D0
        GNORMO=1.0D60
      END IF
      IF (IDEC.LT.0) IDEC=0
      IF (IDEC.NE.0.AND.IDEC.NE.1) THEN
        ITERD=-1
        GO TO 90
      END IF
      GNORM=SQRT(MXUDOT(NF,G,G,IX,KBF))
      IF (GNORM.GE.1.0D3*GNORMO) EPS=1.0D-6
      GNORMO=GNORM
      RHO1=MXUDOT(NF,G,G,IX,KBF)
      IF (XDEL.LE.0.0D0) THEN
!
!     INITIAL TRUST REGION BOUND
!
        RHO2=MXSSMQ(NF,H,IH,JH,G,G)
        IF (RHO2.LE.0.0D0) THEN
          XDEL=GNORM
        ELSE
          XDEL=(GNORM*GNORM/RHO2)*GNORM
        END IF
        IF (IEST.EQ.1) XDEL=MIN(XDEL,4.0D0*(F-FMIN)/GNORM)
        XDEL=MIN(XDEL,XMAX)
      END IF
      PAR=MIN(EPS,SQRT(GNORM))
      IF (PAR.GT.1.0D-2) THEN
        PAR=MIN(PAR,1.0D0/DBLE(NIT))
      END IF
      PAR=PAR*PAR
      NOS1=MIN(NF,MOS1)
      IF (NOS1.LE.1) THEN
        T=0.0D0
      ELSE
!
!     INCOMPLETE LANCZOS TRIDIAGONALIZATION
!
        INF=0
        CALL MXVCOP (NF, G, XS)
        CALL MXVSET (NF, 0.0D0, GS)
        CALL MXVSCL (NF, 1.0D0/MXUNOR(NF,XS,IX,KBF), XS, XS)
        DO 20 NRED=1,NOS1
          IF (NRED.GT.1) THEN
            DO 10 I=1,NF
              EL=XS(I)
              XS(I)=GS(I)/EU
              GS(I)=-EU*EL
   10       CONTINUE
          END IF
          CALL MXSSMD (NF, H, IH, JH, XS, 1.0D0, GS, GS)
          EL=MXUDOT(NF,XS,GS,IX,KBF)
          CALL MXUDIR (NF, -EL, XS, GS, GS, IX, KBF)
          EU=MXUNOR(NF,GS,IX,KBF)
          IF (EU.LE.0.0D0) THEN
            INF=NRED
            GO TO 30
          END IF
          XO(NRED)=EL
          GO(NRED)=EU
   20   CONTINUE
   30   CONTINUE
        CALL MXVCOR (NOS1, ETA0, XO)
        T=0.0D0
        RHO2=DEL1*XDEL
        DO 40 NRED=1,10
          T=MIN(T,1.0D5)
          IF (T.GE.1.0D5) GO TO 50
!
!     SOLUTION OF THE TRIDIAGONAL SYSTEM
!
          ALF=ETA0
          CALL MXVSET (NOS1, T, XS)
          CALL MXVSUM (NOS1, XO, XS, XS)
          CALL MXVCOP (NOS1, GO, GS)
          CALL MXTPGF (NOS1, XS, GS, INF, ALF, TAU)
          CALL MXVSET (NOS1, 0.0D0, S)
          S(1)=GNORM
          CALL MXTPGB (NOS1, XS, GS, S, 0)
          RHO=MXVDOT(NOS1,S,S)
          IF (RHO.LE.XDEL**2) GO TO 50
          CALL MXTPGB (NOS1, XS, GS, S, 1)
!
!     MARQUARDT PARAMETER T IS COMPUTED USING THE ONE-DIMENSIONAL
!     NEWTON METHOD
!
          T=T+(RHO/MXVVDP(NOS1,XS,S,S))*((SQRT(RHO)-RHO2)/RHO2)
   40   CONTINUE
      END IF
   50 CONTINUE
      CALL MXVNEG (NF, G, XO)
      NOS2=MOS2-1
      IF (NOS2.GT.0) THEN
!
!     INCOMPLETE GILL-MURRAY DECOMPOSITION
!
        ALF=ETA2
        M=IH(NF+1)-1
        IF (2*M.GE.MMAX) THEN
          ITERM=-48
          GO TO 90
        END IF
        CALL MXVCOP (M, H, H(M+1))
        IF (T.GT.0.0D0) CALL MXSSDA (NF, H(M+1), IH, T)
        CALL MXSPTF (NF, H(M+1), IH, JH, IW, INF, ALF, SIG)
        IF (INF+10.LT.0) THEN
          ITERM=-48
          GO TO 90
        END IF
        IF (MOS3.EQ.0) THEN
          IF (INF.NE.0) NOS2=0
        ELSE IF (MOS3.EQ.1) THEN
          IF (INF.LT.0) NOS2=0
        END IF
        NDEC=NDEC+1
        IDEC=1
        IF (NOS2.GT.1) THEN
!
!     PRELIMINARY INEXACT SOLUTION
!
          CALL MXSPTB (NF, H(M+1), IH, JH, XO, 0)
          SNORM=SQRT(MXUDOT(NF,XO,XO,IX,KBF))
          IF (SNORM.LE.XDEL*1.0D5) THEN
            CALL MXVCOP (NF, XO, S)
            IF (SNORM.LE.XDEL) THEN
              ITERD=2
            ELSE
              CALL MXVSCL (NF, XDEL/SNORM, S, S)
              SNORM=XDEL
              ITERD=3
            END IF
            CALL MXSSMD (NF, H, IH, JH, S, 1.0D0, G, GO)
            IF (MXUDOT(NF,GO,GO,IX,KBF).LE.1.0D-2*PAR*RHO1) GO TO 90
          END IF
        END IF
      END IF
!
!     CG INITIATION
!
      RHO=RHO1
      SNORM=0.0D0
      CALL MXVSET (NF, 0.0D0, S)
      CALL MXVNEG (NF, G, XS)
      IF (NOS2.EQ.0) THEN
      ELSE IF (NOS2.EQ.1) THEN
        CALL MXSPTB (NF, H(M+1), IH, JH, XO, 0)
        RHO=MXUDOT(NF,XS,XO,IX,KBF)
      ELSE
        RHO=MXUDOT(NF,XS,XO,IX,KBF)
      END IF
      DO 60 NRED=1,NF+3
        IF (T.GT.0.0D0) THEN
          CALL MXSSMD (NF, H, IH, JH, XO, T, XO, GO)
        ELSE
          CALL MXSSMM (NF, H, IH, JH, XO, GO)
        END IF
        ALF=MXUDOT(NF,XO,GO,IX,KBF)
        IF (ALF.LE.0.0D0) GO TO 80
        ALF=RHO/ALF
        RHO2=SQRT(MXUDEL(NF,ALF,XO,S,IX,KBF))
        IF (RHO2.GE.XDEL) GO TO 80
!
!     CG STEP
!
        CALL MXUDIR (NF, ALF, XO, S, S, IX, KBF)
        CALL MXUDIR (NF, -ALF, GO, XS, XS, IX, KBF)
        NIN=NIN+1
        SNORM=RHO2
        RHO2=MXUDOT(NF,XS,XS,IX,KBF)
        IF (RHO2.LE.PAR*RHO1) GO TO 70
        IF (NRED.GE.NF+3) GO TO 70
        IF (NOS2.NE.0) THEN
          CALL MXVCOP (NF, XS, GO)
          CALL MXSPTB (NF, H(M+1), IH, JH, GO, 0)
          RHO2=MXUDOT(NF,XS,GO,IX,KBF)
          ALF=RHO2/RHO
          CALL MXUDIR (NF, ALF, XO, GO, XO, IX, KBF)
        ELSE
          ALF=RHO2/RHO
          CALL MXUDIR (NF, ALF, XO, XS, XO, IX, KBF)
        END IF
        RHO=RHO2
   60 CONTINUE
!
!     AN INEXACT SOLUTION IS OBTAINED
!
   70 CONTINUE
      SNORM=SQRT(MXUDOT(NF,S,S,IX,KBF))
      ITERD=2
      GO TO 90
!
!     BOUNDARY STEP IS COMPUTED
!
   80 CONTINUE
      RHO1=MXUDOT(NF,XO,S,IX,KBF)
      RHO2=MXUDOT(NF,XO,XO,IX,KBF)
      CALL PNSTEP (XDEL, SNORM, RHO1, RHO2, ALF)
      CALL MXUDIR (NF, ALF, XO, S, S, IX, KBF)
      SNORM=XDEL
      ITERD=3
      NRED=-NRED
   90 CONTINUE
      PP=MXSSMQ(NF,H,IH,JH,S,S)*0.5D0
      IF (KD.GT.0) P=MXUDOT(NF,G,S,IX,KBF)
      RETURN
      END
! SUBROUTINE PDSGM7               ALL SYSTEMS                 01/09/22
! PURPOSE :
! COMPUTATION OF A TRUST-REGION STEP BY THE MORE-SORENSEN METHOD WITH
! DIRECT MATRIX DECOMPOSITIONS.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  II  MMAX  MAXIMUM DIMENSION OF THE SPARSE TABLEAU.
!  II  MH  POINTER OBTAINED BY THE SUBROUTINE MXSPCC.
!  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.
!  RO  G(NF)  GRADIENT OF THE OBJECTIVE FUNCTION.
!  RA  H(MMAX)  NONZERO ELEMENTS OF THE APPROXIMATION OF THE SPARSE
!         HESSIAN MATRIX TOGETHER WITH AN ADDITIONAL SPACE USED FOR
!         THE NUMERICAL DIFFERENTIATION.
!  II  IH(NF+1)  POINTERS OF DIAGONAL ELEMENTS OF THE MATRIX H.
!  IU  JH(MMAX)  INDICES OF NONZERO ELEMENTS OF THE MATRIX H
!         TOGETHER WITH AN ADDITIONAL SPACE USED FOR THE NUMERICAL
!         DIFFERENTIATION.
!  RO  S(NF)  DIRECTION VECTOR.
!  RU  XO(NF)  VECTORS OF VARIABLES DIFFERENCE.
!  RI  GO(NF)  GRADIENTS DIFFERENCE.
!  II  PSL(NF+1)  POINTER VECTOR OF THE COMPACT FORM OF THE TRIANGULAR
!         FACTOR OF THE HESSIAN APPROXIMATION.
!  IA  PERM(NF)  PERMUTATION VECTOR.
!  IA  WN11(NF+1) AUXILIARY VECTOR.
!  IA  WN12(NF+1) AUXILIARY VECTOR.
!  RI  XMAX  MAXIMUM STEPSIZE.
!  RI  XDEL  TRUST REGION RADIUS.
!  RO  XDELO  OLD TRUST REGION RADIUS.
!  RO  GNORM  NORM OF THE GRADIENT VECTOR.
!  RO  SNORM  NORM OF THE DIRECTION VECTOR.
!  RI  FMIN  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RO  P  VALUE OF THE DIRECTIONAL DERIVATIVE.
!  RO  PP  VALUE OF THE QUADRATIC TERM.
!  RI  ETA2  TOLERANCE FOR POSITIVE DEFINITENESS.
!  RI  DEL1  LOWER TOLERANCE FOR THE TRUST-REGION RADIUS.
!  RI  DEL2  UPPER TOLERANCE FOR THE TRUST-REGION RADIUS.
!  II  KD  ORDER OF COMPUTED DERIVATIVES.
!  II  KBF  SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS.
!         KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS.
!  II  IEST  ESTIMATION INDICATOR. IEST=0-MINIMUM IS NOT ESTIMATED.
!         IEST=1-MINIMUM IS ESTIMATED BY THE VALUE FMIN.
!  II  IDIR  TRUST-REGION CHANGE INDICATOR.
!  IU  IDEC  DECOMPOSITION INDICATOR. IDEC=0-NO DECOMPOSITION.
!  IU  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  II  ITERD  CAUSE OF TERMINATION IN THE DIRECTION DETERMINATION.
!         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  ITERM  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=3-IF F WAS LESS THAN OR EQUAL TO TOLB.
!         ITERM=4-IF GMAX WAS LESS THAN OR EQUAL TO TOLG.
!         ITERM=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!         VALUES ITERM<=-40 DETECT A LACK OF SPACE.
!
! SUBPROGRAMS USED :
!  S   PNSTEP  COMPUTATION OF THE BOUNDARY STEP.
!  S   MXSPCA  ADDITION OF THE LEVENBERG-MARQUARDT TERM TO THE SPARSE
!         SYMMETRIC MATRIX.
!  S   MXSPCB  BACK SUBSTITUTION USING THE SPARSE DECOMPOSITION
!         OBTAINED BY MXSPCF.
!  S   MXSPCD  COMPUTATION OF A DIRECTION OF NEGATIVE CURVATURE USING
!         THE SPARSE DECOMPOSITION OBTAINED BY MXSPCF.
!  S   MXSPCF  GILL-MURRAY DECOMPOSITION OD A SPARSE SYMMETRIC MATRIX.
!  S   MXSPCN  ESTIMATION OF THE MINIMUM EIGENVALUE AND THE
!         CORRESPONDING EIGENVECTOR OF A SYMMETRIC MATRIX USING THE
!         SPARSE DECOMPOSITION OBTAINED BY MXSPCF.
!  RF  MXSPCP  GENERALIZED DOT PRODUCT USING THE SPARSE DECOMPOSITION
!         OBTAINED BY MXSPCF.
!  S   MXSPCT  COPYING A SPARSE SYMMETRIC MATRIX INTO THE PERMUTED
!         FACTORIZED COMPACT SCHEME.
!  RF  MXSSDL  DETERMINATION OF A MINIMUM DIAGONAL ELEMENT OF A SPARSE
!         SYMMETRIC MATRIX.
!  S   MXSSMG  GERSHGORIN BOUNDS FOR EIGENVALUES OF A SPARSE SYMMETRIC
!         MATRIX
!  RF  MXSSMQ  COMPUTATION OF THE SPARSE QUADRATIC TERM.
!  S   MXUCOP  COPYING OF A VECTOR.
!  S   MXUDIR  VECTOR AUGMENTED BY THE SCALED VECTOR.
!  RF  MXUDOT  DOT PRODUCT OF TWO VECTORS.
!  S   MXUNEG  COPYING OF A VECTOR WITH CHANGE OF THE SIGN.
!  S   MXVSBP  INVERSE PERMUTATION OF A VECTOR
!  S   MXVSFP  PERMUTATION OF A VECTOR.
!
! METHOD :
! J.J.MORE, D.C.SORENSEN: COMPUTING A TRUST REGION STEP. REPORT NO.
! ANL-81-83, ARGONNE NATIONAL LAB. 1981.
!
      SUBROUTINE PDSGM7 (NF, MMAX, MH, IX, G, H, IH, JH, S, XO, GO, PSL,
     & PERM, WN11, WN12, XMAX, XDEL, XDELO, GNORM, SNORM, FMIN, F, P,
     &PP, ETA2, DEL1, DEL2, KD, KBF, IEST, IDIR, IDEC, NDEC, ITERD,
     &ITERM)
      INTEGER NF,MMAX,MH,IX(*),IH(*),JH(*),PSL(*),PERM(*),WN11(*),WN12(*
     &),KD,KBF,IEST,IDIR,IDEC,NDEC,ITERD,ITERM
      DOUBLE PRECISION G(*),H(*),S(*),XO(*),GO(*),XMAX,XDEL,XDELO,GNORM,
     &SNORM,FMIN,F,P,PP,ETA2,DEL1,DEL2
      INTEGER NRED,MM,INF,MODE
      DOUBLE PRECISION T,TL,TU,E,EL,EU,ALF,RHO,RHO1,RHO2,CON
      DOUBLE PRECISION MXSSMQ,MXSPCP,MXSSDL,MXUDOT
      SAVE  T,TL,TU,E,EL,EU
!
!     DIRECTION DETERMINATION
!
      IF (IDEC.LT.0) IDEC=0
      IF (IDEC.NE.0) THEN
        ITERD=-1
        GO TO 40
      END IF
      MM=IH(NF+1)-1
      GNORM=SQRT(MXUDOT(NF,G,G,IX,KBF))
      IF (XDEL.LE.0.0D0) THEN
!
!     INITIAL TRUST REGION BOUND
!
        RHO1=MXSSMQ(NF,H,IH,JH,G,G)
        RHO2=GNORM*GNORM
        IF (RHO1.LE.0.0D0) THEN
          XDEL=GNORM
        ELSE
          XDEL=(RHO2/RHO1)*GNORM
        END IF
        IF (IEST.EQ.1) XDEL=MIN(XDEL,4.0D0*(F-FMIN)/GNORM)
        XDEL=MIN(XDEL,XMAX)
      END IF
!
!     INITIAL BOUNDS FOR THE PARAMETER T
!
      NRED=0
      IF (IDIR.LE.0) THEN
        T=0.0D0
        E=-MXSSDL(NF,H,IH,JH,INF)
        CALL MXSSMG (NF, H, IH, JH, EL, EU, S)
        TL=GNORM/XDEL-EU
        TU=GNORM/XDEL-EL
      ELSE IF (IDIR.EQ.1) THEN
        T=T*XDELO/XDEL
        TL=MAX(TL,GNORM/XDEL-EU)
        TU=GNORM/XDEL-EL
      ELSE IF (IDIR.EQ.2) THEN
        T=T*XDELO/XDEL
        TL=GNORM/XDEL-EU
        TU=MIN(TU,GNORM/XDEL-EL)
      END IF
      TL=MAX(TL,0.0D0,E)
      TU=MAX(TL,TU)
      T=MAX(T,TL)
      T=MIN(T,TU)
   10 TL=MAX(TL,E)
      IF (T.LE.E.AND.NRED.NE.0) THEN
!
!     THE PARAMETER T IS SHIFTED
!
        T=SQRT(TL*TU)
        T=MAX(T,TL+0.1D0*(TU-TL))
        T=MIN(T,TL+0.9D0*(TU-TL))
      END IF
      ALF=ETA2
      CALL MXSPCT (NF, MM, MH, MMAX, H, JH, PSL, ITERM)
      IF (ITERM.NE.0) THEN
        GO TO 40
      END IF
!
!     SPARSE GILL-MURRAY DECOMPOSITION
!
      CALL MXSPCA (NF, MM, MH, H, IH, JH, T)
      CALL MXSPCF (NF, H(MM+1), PSL, JH(MM+1), WN11, WN12, GO, INF, ALF,
     & RHO)
      NDEC=NDEC+1
      IF (INF.GT.0) THEN
!
!     NEW ESTIMATION E IS COMPUTED (THE MATRIX IS NOT POSITIVE DEFINITE)
!
        IF (E.GE.TU) THEN
          ITERD=-2
          GO TO 40
        ELSE
          MODE=2
          CALL MXSPCD (NF, H(MM+1), PSL, JH(MM+1), S, INF)
          CALL MXVSBP (NF, PERM, S, GO)
          E=MAX(E,T-ALF/MXUDOT(NF,S,S,IX,KBF))
          NRED=NRED+1
          GO TO 10
        END IF
      ELSE
!
!     STEP S IS COMPUTED
!
        CALL MXUNEG (NF, G, S, IX, KBF)
        CALL MXVSFP (NF, PERM, S, GO)
        CALL MXSPCB (NF, H(MM+1), PSL, JH(MM+1), S, 0)
        CALL MXVSBP (NF, PERM, S, GO)
        SNORM=SQRT(MXUDOT(NF,S,S,IX,KBF))
        MODE=1
      END IF
      IF (TU-TL.LE.1.0D-8) THEN
!
!     INTERVAL IS TOO SMALL
!
        IF (T.NE.0.0D0) THEN
          ITERD=5
        ELSE
          ITERD=1
        END IF
        GO TO 30
      ELSE IF (NRED.GE.20) THEN
!
!     MAXIMUM NUMBER OF OLC REDUCTIONS
!
        ITERD=6
        GO TO 30
      ELSE IF (SNORM.GT.DEL2*XDEL) THEN
!
!     STEP IS TOO LARGE
!
        TL=MAX(TL,T)
        GO TO 20
      ELSE IF (SNORM.LT.DEL1*XDEL) THEN
        IF (T.NE.0.0D0) THEN
!
!     STEP IS TOO SMAL
!
          TU=MIN(TU,T)
        ELSE
!
!     STEP IS ACCEPTABLE
!
          ITERD=1
          GO TO 30
        END IF
      ELSE
        ITERD=3
        GO TO 30
      END IF
!
!     TRYING TO USE BOUNDARY STEP
!
      CALL MXSPCN (NF, H(MM+1), PSL, JH(MM+1), XO, RHO, 1)
      CALL MXVSBP (NF, PERM, XO, GO)
      RHO1=MXUDOT(NF,XO,S,IX,KBF)
      RHO2=MXUDOT(NF,XO,XO,IX,KBF)
      CALL PNSTEP (XDEL, SNORM, ABS(RHO1), RHO2, ALF)
      CON=(1.0D0-DEL1)*(1.0D0+DEL1)
      IF (ALF*ALF*RHO.LE.CON*(T*XDEL*XDEL-MXUDOT(NF,G,S,IX,KBF))) THEN
        IF (RHO1.LT.0.0D0) ALF=-ALF
        CALL MXUDIR (NF, ALF, XO, S, S, IX, KBF)
        SNORM=XDEL
        ITERD=3
        GO TO 30
      ELSE
        E=MAX(E,T-RHO)
      END IF
   20 CONTINUE
      IF (GNORM.LE.0.0D0) THEN
        T=E
      ELSE
!
!     NEW T IS COMPUTED USING ONE STEP OF THE NEWTON METHOD FOR
!     NONLINEAR EQUATION
!
        CALL MXUCOP (NF, S, XO, IX, KBF)
        CALL MXVSFP (NF, PERM, XO, GO)
        CALL MXSPCB (NF, H(MM+1), PSL, JH(MM+1), XO, 1)
        T=T+(SNORM*SNORM/MXSPCP(NF,H(MM+1),PSL,XO))*(SNORM-XDEL)/XDEL
        CALL MXVSBP (NF, PERM, XO, GO)
      END IF
      NRED=NRED+1
      GO TO 10
   30 CONTINUE
      PP=MXSSMQ(NF,H,IH,JH,S,S)*0.5D0
   40 CONTINUE
      IF (KD.GT.0) P=MXUDOT(NF,G,S,IX,KBF)
      RETURN
      END
! SUBROUTINE PDSLM1               ALL SYSTEMS                 01/09/22
! PURPOSE :
! DIRECTION DETERMINATION FOR LINE SEARCH USING DIRECT MATRIX
! DECOMPOSITIONS.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  II  MMAX  MAXIMUM DIMENSION OF THE SPARSE TABLEAU.
!  II  MH  POINTER OBTAINED BY THE SUBROUTINE MXSPCC.
!  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.
!  RO  G(NF)  GRADIENT OF THE OBJECTIVE FUNCTION.
!  RA  H(MMAX)  NONZERO ELEMENTS OF THE APPROXIMATION OF THE SPARSE
!         HESSIAN MATRIX TOGETHER WITH AN ADDITIONAL SPACE USED FOR
!         THE NUMERICAL DIFFERENTIATION.
!  II  IH(NF+1)  POINTERS OF DIAGONAL ELEMENTS OF THE MATRIX H.
!  IU  JH(MMAX)  INDICES OF NONZERO ELEMENTS OF THE MATRIX H
!         TOGETHER WITH AN ADDITIONAL SPACE USED FOR THE NUMERICAL
!         DIFFERENTIATION.
!  RO  S(NF)  DIRECTION VECTOR.
!  RU  XO(NF)  VECTORS OF VARIABLES DIFFERENCE.
!  II  PSL(NF+1)  POINTER VECTOR OF THE COMPACT FORM OF THE TRIANGULAR
!         FACTOR OF THE HESSIAN APPROXIMATION.
!  IA  PERM(NF)  PERMUTATION VECTOR.
!  IA  WN11(NF+1) AUXILIARY VECTOR.
!  IA  WN12(NF+1) AUXILIARY VECTOR.
!  RO  GNORM  NORM OF THE GRADIENT VECTOR.
!  RO  SNORM  NORM OF THE DIRECTION VECTOR.
!  RI  ETA2  TOLERANCE FOR POSITIVE DEFINITENESS.
!  II  KBF  SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS.
!         KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS.
!  IU  IDEC  DECOMPOSITION INDICATOR. IDEC=0-NO DECOMPOSITION.
!  IU  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  II  ITERD  CAUSE OF TERMINATION IN THE DIRECTION DETERMINATION.
!         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  ITERM  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=3-IF F WAS LESS THAN OR EQUAL TO TOLB.
!         ITERM=4-IF GMAX WAS LESS THAN OR EQUAL TO TOLG.
!         ITERM=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!         VALUES ITERM<=-40 DETECT A LACK OF SPACE.
!
! SUBPROGRAMS USED :
!  S   MXSPCB  BACK SUBSTITUTION USING THE SPARSE DECOMPOSITION
!         OBTAINED BY MXSPCF.
!  S   MXSPCF  GILL-MURRAY DECOMPOSITION OD A SPARSE SYMMETRIC MATRIX.
!  S   MXSPCT  COPYING A SPARSE SYMMETRIC MATRIX INTO THE PERMUTED
!         FACTORIZED COMPACT SCHEME.
!  RF  MXUDOT  DOT PRODUCT OF TWO VECTORS.
!  S   MXUNEG  COPYING OF A VECTOR WITH CHANGE OF THE SIGN.
!  S   MXVSBP  INVERSE PERMUTATION OF A VECTOR
!  S   MXVSFP  PERMUTATION OF A VECTOR.
!
      SUBROUTINE PDSLM1 (NF, MMAX, MH, IX, G, H, IH, JH, S, XO, PSL,
     &PERM, WN11, WN12, GNORM, SNORM, ETA2, KBF, IDEC, NDEC, ITERD,
     &ITERM)
      INTEGER NF,MMAX,MH,IX(*),IH(*),JH(*),PSL(*),PERM(*),WN11(*),WN12(*
     &),KBF,IDEC,NDEC,ITERD,ITERM
      DOUBLE PRECISION G(*),H(*),S(*),XO(*),GNORM,SNORM,ETA2
      INTEGER MM,INF
      DOUBLE PRECISION ALF,BET
      DOUBLE PRECISION MXUDOT
!
!     DIRECTION DETERMINATION
!
      IF (IDEC.LT.0) IDEC=0
      MM=IH(NF+1)-1
      IF (IDEC.EQ.0) THEN
        CALL MXSPCT (NF, MM, MH, MMAX, H, JH, PSL, ITERM)
        IF (ITERM.NE.0) RETURN
!
!     SPARSE GILL-MURRAY DECOMPOSITION
!
        ALF=ETA2
        CALL MXSPCF (NF, H(MM+1), PSL, JH(MM+1), WN11, WN12, XO, INF,
     &   ALF, BET)
        NDEC=NDEC+1
        IDEC=1
      ELSE IF (IDEC.EQ.1) THEN
      ELSE
        ITERD=-1
        RETURN
      END IF
      GNORM=SQRT(MXUDOT(NF,G,G,IX,KBF))
!
!     NEWTON LIKE STEP
!
      CALL MXUNEG (NF, G, S, IX, KBF)
      CALL MXVSFP (NF, PERM, S, XO)
      CALL MXSPCB (NF, H(MM+1), PSL, JH(MM+1), S, 0)
      CALL MXVSBP (NF, PERM, S, XO)
      ITERD=1
      SNORM=SQRT(MXUDOT(NF,S,S,IX,KBF))
      RETURN
      END
! SUBROUTINE PDSLM3               ALL SYSTEMS                 01/09/22
! PURPOSE :
! DIRECTION DETERMINATION FOR LINE SEARCH USING CONJUGATE GRADIENT
! ITERATIONS.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  II  M  NUMBER OF NONZERO ELEMENTS IN THE HESSIAN MATRIX.
!  II  MMAX  MAXIMUM DIMENSION OF THE SPARSE TABLEAU.
!  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.
!  RO  G(NF)  GRADIENT OF THE OBJECTIVE FUNCTION.
!  RA  H(MMAX)  NONZERO ELEMENTS OF THE APPROXIMATION OF THE SPARSE
!         HESSIAN MATRIX TOGETHER WITH AN ADDITIONAL SPACE USED FOR
!         THE NUMERICAL DIFFERENTIATION.
!  II  IH(NF+1)  POINTERS OF DIAGONAL ELEMENTS OF THE MATRIX H.
!  IU  JH(MMAX)  INDICES OF NONZERO ELEMENTS OF THE MATRIX H
!         TOGETHER WITH AN ADDITIONAL SPACE USED FOR THE NUMERICAL
!         DIFFERENTIATION.
!  RO  S(NF)  DIRECTION VECTOR.
!  RU  XO(NF)  VECTORS OF VARIABLES DIFFERENCE.
!  RI  GO(NF)  GRADIENTS DIFFERENCE.
!  RA  XS(NF)  AUXILIARY VECTOR.
!  RA  IW(NF+1)  AUXILIARY VECTOR.
!  RO  GNORM  NORM OF THE GRADIENT VECTOR.
!  RO  SNORM  NORM OF THE DIRECTION VECTOR.
!  RI  ETA2  TOLERANCE FOR POSITIVE DEFINITENESS.
!  RI  ETA9  MAXIMUM FOR REAL NUMBERS.
!  II  KBF  SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS.
!         KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS.
!  II  MOS2  TYPE OF PRECONDITIONING. MOS2=1-PRECONDITIONING IS NOT
!         USED. MOS2=2-PRECONDITIONING BY THE INCOMPLETE GILL-MURRAY
!         DECOMPOSITION. MOS2=3-PRECONDITIONING BY THE INCOMPLETE
!         GILL-MURRAY DECOMPOSITION WITH A PRELIMINARY SOLUTION OF
!         THE PRECONDITIONED SYSTEM WHICH IS USED IF IT SATISFIES
!         THE TERMINATION CRITERION.
!  IU  IDEC  DECOMPOSITION INDICATOR. IDEC=0-NO DECOMPOSITION.
!  IU  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  II  NIT  NUMBER OF OUTER ITERATIONS.
!  IU  NIN NUMBER OF INNER CONJUGATE GRADIENT ITERATIONS.
!  II  ITERD  CAUSE OF TERMINATION IN THE DIRECTION DETERMINATION.
!         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  ITERM  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) SUBSEQUENT ITERATIONS.
!         ITERM=3-IF F WAS LESS THAN OR EQUAL TO TOLB.
!         ITERM=4-IF GMAX WAS LESS THAN OR EQUAL TO TOLG.
!         ITERM=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
!                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!         VALUES ITERM<=-40 DETECT A LACK OF SPACE.
!
! SUBPROGRAMS USED :
!  S   MXSPTB  BACK SUBSTITUTION AFTER THE GILL-MURRAY DECOMPOSITION.
!  S   MXSPTF  INCOMPLETE GILL-MURRAY DECOMPOSITION.
!  S   MXSSMD  MATRIX-VECTOR PRODUCT FOLLOWED BY THE ADDITION OF A
!         SCALED VECTOR.
!  S   MXSSMM  MATRIX-VECTOR PRODUCT.
!  S   MXUDIR  VECTOR AUGMENTED BY THE SCALED VECTOR.
!  RF  MXUDOT  DOT PRODUCT OF TWO VECTORS.
!  S   MXVCOP  COPYING OF A VECTOR.
!  S   MXVNEG  COPYING OF A VECTOR WITH CHANGE OF THE SIGN.
!  S   MXVSET  INITIATION OF A VECTOR.
!
      SUBROUTINE PDSLM3 (NF, M, MMAX, IX, G, H, IH, JH, S, XO, GO, XS,
     &IW, GNORM, SNORM, ETA2, ETA9, KBF, MOS2, IDEC, NDEC, NIT, NIN,
     &ITERD, ITERM)
      INTEGER NF,M,MMAX,IX(*),IH(*),JH(*),IW(*),KBF,MOS2,IDEC,NDEC,NIT,
     &NIN,ITERD,ITERM
      DOUBLE PRECISION G(*),H(*),S(*),XO(*),GO(*),XS(*),GNORM,SNORM,
     &ETA2,ETA9
      INTEGER NOS2,NRED,MMX,INF
      DOUBLE PRECISION PAR,ALF,EPS,RHO,RHO1,RHO2,SIG
      DOUBLE PRECISION MXUDOT
      SAVE  EPS
!
!     DIRECTION DETERMINATION
!
      IF (NIT.LE.1) THEN
        EPS=0.9D0
      END IF
      NOS2=MOS2-1
      IF (IDEC.LT.0) IDEC=0
      IF (IDEC.NE.0.AND.IDEC.NE.1) THEN
        ITERD=-1
        RETURN
      ELSE IF (IDEC.EQ.0) THEN
        IF (MOS2.GT.1) THEN
!
!     INCOMPLETE GILL-MURRAY DECOMPOSITION
!
          ALF=ETA2
          IF (2*M.GE.MMAX) THEN
            ITERM=-48
            RETURN
          END IF
          CALL MXVCOP (M, H, H(M+1))
          CALL MXSPTF (NF, H(M+1), IH, JH, IW, INF, ALF, SIG)
          IF (INF+10.LT.0) THEN
            ITERM=-48
            RETURN
          END IF
          IF (INF.NE.0) NOS2=0
          NDEC=NDEC+1
          IDEC=1
        END IF
      END IF
      RHO1=MXUDOT(NF,G,G,IX,KBF)
      GNORM=SQRT(RHO1)
      PAR=MIN(EPS,SQRT(GNORM))
      IF (PAR.GT.1.0D-2) THEN
        PAR=MIN(PAR,1.0D0/DBLE(NIT))
      END IF
      PAR=PAR*PAR
      IF (MOS2.GT.2) THEN
!
!     PRELIMINARY INEXACT SOLUTION
!
        CALL MXVNEG (NF, G, XO)
        IF (NOS2.NE.0) THEN
          CALL MXSPTB (NF, H(M+1), IH, JH, XO, 0)
          CALL MXVCOP (NF, XO, S)
          CALL MXSSMD (NF, H, IH, JH, S, 1.0D0, G, GO)
          IF (MXUDOT(NF,GO,GO,IX,KBF).LE.1.0D-2*PAR*RHO1) THEN
            SNORM=SQRT(MXUDOT(NF,S,S,IX,KBF))
            ITERD=2
            RETURN
          END IF
        END IF
      END IF
!
!     CG INITIATION
!
      RHO=RHO1
      SNORM=0.0D0
      CALL MXVSET (NF, 0.0D0, S)
      CALL MXVNEG (NF, G, XS)
      IF (NOS2.EQ.0) THEN
        CALL MXVNEG (NF, G, XO)
      ELSE IF (MOS2.GT.2) THEN
        RHO=MXUDOT(NF,XS,XO,IX,KBF)
      ELSE
        CALL MXVNEG (NF, G, XO)
        CALL MXSPTB (NF, H(M+1), IH, JH, XO, 0)
        RHO=MXUDOT(NF,XS,XO,IX,KBF)
      END IF
!      SIG=RHO
      MMX=NF+3
      DO 10 NRED=1,MMX
        CALL MXSSMM (NF, H, IH, JH, XO, GO)
        ALF=MXUDOT(NF,XO,GO,IX,KBF)
        IF (ALF.LE.1.0D0/ETA9) THEN
!      IF (ALF.LE.1.0D-8*SIG) THEN
!
!     CG FAILS (THE MATRIX IS NOT POSITIVE DEFINITE)
!
          IF (NRED.EQ.1) THEN
            CALL MXVNEG (NF, G, S)
            SNORM=GNORM
          END IF
          ITERD=0
          RETURN
        ELSE
          ITERD=2
        END IF
!
!     CG STEP
!
        ALF=RHO/ALF
        CALL MXUDIR (NF, ALF, XO, S, S, IX, KBF)
        CALL MXUDIR (NF, -ALF, GO, XS, XS, IX, KBF)
        NIN=NIN+1
        RHO2=MXUDOT(NF,XS,XS,IX,KBF)
        SNORM=SQRT(MXUDOT(NF,S,S,IX,KBF))
        IF (RHO2.LE.PAR*RHO1) RETURN
        IF (NRED.GE.MMX) RETURN
        IF (NOS2.NE.0) THEN
          CALL MXVCOP (NF, XS, GO)
          CALL MXSPTB (NF, H(M+1), IH, JH, GO, 0)
          RHO2=MXUDOT(NF,XS,GO,IX,KBF)
          ALF=RHO2/RHO
          CALL MXUDIR (NF, ALF, XO, GO, XO, IX, KBF)
        ELSE
          ALF=RHO2/RHO
          CALL MXUDIR (NF, ALF, XO, XS, XO, IX, KBF)
        END IF
        RHO=RHO2
!      SIG=RHO2+ALF*ALF*SIG
   10 CONTINUE
      RETURN
      END
! SUBROUTINE PF1HS2                ALL SYSTEMS                99/12/01
! PURPOSE :
! NUMERICAL COMPUTATION OF THE HESSIAN MATRIX OF THE MODEL FUNCTION
! USING ITS GRADIENTS - SPARSE VERSION USING DIRECT COLOURING METHOD.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  II  ML SIZE OF THE COMPACT FACTOR.
!  II  M  NUMBER OF NONZERO ELEMENTS OF THE SPARSE HESSIAN MATRIX.
!  RI  X(NF)  VECTOR OF VARIABLES.
!  II  IX(NF)  VECTOR CONTAINING TYPES OF BOUNDS.
!  RA  XO(NF)  AUXILIARY VECTOR.
!  RO  HF(M)  HESSIAN MATRIX OF THE MODEL FUNCTION.
!  IU  IH(NF+1)  POINTER VECTOR OF SPARSE HESSIAN MATRIX.
!  IU  JH(M)  INDEX VECTOR OF THE HESSIAN MATRIX.
!  RI  GF(NF)  GRADIENT OF THE MODEL FUNCTION.
!  RA  GO(NF)  AUXILIARY VECTOR.
!  II  COL(NF)  VECTOR DISCERNING GROUPS OF THE HESSIAN COLUMN OF THE
!         SAME COLOUR.
!  IA  WN11(NF+1)  AUXILIARY VECTOR.
!  IA  WN12(NF+1)  AUXILIARY VECTOR.
!  RA  XS(NF)  AUXILIARY VECTOR USED FOR STEP SIZES.
!  RI  FF  VALUE OF THE MODEL FUNCTION.
!  RI  ETA1  PRECISION OF THE COMPUTED VALUES.
!  II  KBF  TYPE OF BOUNDS. KBF=0-BOUNDS ARE NOT USED. KBF=1-ONE SIDED
!         BOUNDS. KBF=2-TWO SIDED BOUNDS.
!  IU  ITERM  TERMINATION INDICATOR.
!  IU  ISYS  CONTROL PARAMETER.
!
! SUBPROGRAMS USED :
!  S   MXSTG1  WIDTHEN THE STRUCTURE.
!  S   MXSTL2  SHRINK THE STRUCTURE.
!  S   MXVCOP  COPYING OF A VECTOR.
!  S   MXVSET  INITIATION OF A VECTOR.
!
      SUBROUTINE PF1HS2 (NF, ML, M, X, IX, XO, HF, IH, JH, GF, GO, COL,
     &WN11, WN12, XS, FF, ETA1, KBF, ITERM, ISYS)
      INTEGER NF,ML,M,IX(*),IH(*),JH(*),COL(*),WN11(*),WN12(*),KBF,
     &ITERM,ISYS
      DOUBLE PRECISION X(*),XO(*),HF(*),GF(*),GO(*),XS(*),FF,ETA1
      DOUBLE PRECISION XTEMP,FTEMP,ETA
      INTEGER I,J,J1,K,K1,L,MX,MM,IVAR,JVAR
      SAVE  MX,MM,IVAR,JVAR
      SAVE  XTEMP,FTEMP,ETA
      IF (ITERM.NE.0) GO TO 180
      IF (ISYS.EQ.1) GO TO 60
      MM=IH(NF+1)-1
      IF (3*MM-NF+ML.GE.M) THEN
        ITERM=-45
        ISYS=0
        RETURN
      END IF
      ETA=SQRT(ETA1)
      FTEMP=FF
      CALL MXVCOP (NF, X, XO)
!
!     WIDTHEN THE STRUCTURE
!
      K=2*MM-NF
      DO 10 I=ML+MM,1,-1
        JH(K+I)=JH(MM+I)
   10 CONTINUE
      CALL MXSTG1 (NF, MX, IH, JH, WN12, WN11)
      CALL MXVSET (K, 0.0D0, HF)
      IVAR=1
   20 IF (IVAR.GT.NF) GO TO 130
      DO 30 J=IVAR,NF
        IF (COL(J).GE.1) THEN
          GO TO 30
        ELSE
          JVAR=J
          GO TO 40
        END IF
   30 CONTINUE
   40 CONTINUE
      DO 50 J=IVAR,JVAR
        L=ABS(COL(J))
        IF (KBF.GT.0) THEN
          IF (IX(L).LE.-7) GO TO 50
        END IF
!
!     STEP SELECTION
!
        XS(L)=ETA*MAX(ABS(X(L)),1.0D0)*SIGN(1.0D0,X(L))
        XTEMP=X(L)
        X(L)=XTEMP+XS(L)
        XS(L)=X(L)-XTEMP
   50 CONTINUE
      ISYS=1
      RETURN
   60 CONTINUE
!
!     NUMERICAL DIFFERENTIATION
!
!
!     SET AUXILIARY VECTOR DISCERNING THE SINGLETONS IN A GROUP TO ZERO
!
      DO 70 J1=1,NF
        WN11(J1)=0
   70 CONTINUE
!
!     DISCERN SINGLETONS OF THE GROUP OF THE SAME COLOR.
!
      DO 90 J1=IVAR,JVAR
        L=ABS(COL(J1))
        DO 80 K=IH(L),IH(L+1)-1
          K1=ABS(JH(K))
          IF (WN11(K1).EQ.0) THEN
            WN11(K1)=J1
          ELSE
            WN11(K1)=-1
          END IF
   80   CONTINUE
   90 CONTINUE
!
!     NUMERICAL VALUES COMPUTATION
!
      DO 110 J1=IVAR,JVAR
        L=ABS(COL(J1))
        DO 100 K=IH(L),IH(L+1)-1
          K1=ABS(JH(K))
          IF (WN11(K1).GT.0) THEN
            HF(K)=(GF(K1)-GO(K1))/XS(L)
          END IF
  100   CONTINUE
  110 CONTINUE
!
!     SET THE ORIGINAL VALUE OF X FOR THE COMPONENTS OF THE ACTUAL COLOR
!
      DO 120 J=IVAR,JVAR
        L=ABS(COL(J))
        X(L)=XO(L)
  120 CONTINUE
      IVAR=JVAR+1
      GO TO 20
  130 CONTINUE
!
!     MOVE THE ELEMENTS OF THE HESSIAN APPROXIMATION INTO THE UPPER
!     TRIANGULAR PART
!
      DO 140 I=1,NF
        WN11(I)=WN12(I)+1
  140 CONTINUE
      DO 160 I=1,NF
        IVAR=IH(I)
        JVAR=WN12(I)-1
        DO 150 J=IVAR,JVAR
          K=ABS(JH(J))
          L=WN11(K)
          IF (HF(L).EQ.0) THEN
            HF(L)=HF(J)
          ELSE IF (HF(L).NE.0.AND.HF(J).NE.0) THEN
            HF(L)=0.5D0*(HF(J)+HF(L))
          END IF
          WN11(K)=WN11(K)+1
  150   CONTINUE
  160 CONTINUE
      FF=FTEMP
!
!     SHRINK THE STRUCTURE
!
      CALL MXSTL2 (NF, MX, HF, IH, JH, WN12)
      K=2*MM-NF
      DO 170 I=1,ML+MM
        JH(MM+I)=JH(K+I)
  170 CONTINUE
!
!     RETRIEVE VALUES
!
      CALL MXVCOP (NF, XO, X)
  180 CONTINUE
      ISYS=0
      RETURN
      END
! SUBROUTINE PFSEB4             ALL SYSTEMS                   98/12/01
! PURPOSE :
! COMPUTATION OF THE SPARSE HESSIAN MATRIX FROM THE PARTITIONED HESSIAN
! MATRIX.
!
! PARAMETERS :
!  II  NC  NUMBER OF CONSTRAINTS.
!  RU  B(M)  ELEMENTS OF THE SPARSE MATRIX B.
!  IO  IH(NF+1)  POINTERS OF THE DIAGONAL ELEMENTS OF B.
!  IO  JH(M)  INDICES OF THE NONZERO ELEMENTS OF B.
!  II  CH(MB)  ELEMENTS OF THE PARTITIONED MATRIX H.
!  II  ICG(NC+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
!  II  JCG(MC)  COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
!  II  ICA(NC)  VECTOR CONTAINING TYPES OF CONSTRAINTS.
!  RI  CZL(NC)  VECTOR CONTAINING LOWER MULTIPLIERS FOR CONSTRAINTS.
!  RI  CZU(NC)  VECTOR CONTAINING UPPER MULTIPLIERS FOR CONSTRAINTS.
!  II  JOB  SUBJECTS OF UPDATES. JOB=0-CONSTRAINT FUNCTIONS.
!         JOB=1-CONSTRAINT FUNCTIONS MULTIPLIED BY SIGNS OF THE
!         LAGRANGIAN MULTIPLIERS. JOB-2-ACTIVE TERMS OF THE LAGRANGIAN
!         FUNCTION. JOB-3-ALL TERMS OF THE LAGRANGIAN FUNCTION.
!
      SUBROUTINE PFSEB4 (NC, B, IH, JH, CH, ICG, JCG, ICA, CZL, CZU,
     &JOB)
      INTEGER NC,IH(*),JH(*),ICG(*),JCG(*),ICA(*),JOB
      DOUBLE PRECISION B(*),CH(*),CZL(*),CZU(*)
      INTEGER I,II,IC,J,JJ,JC,JF,K,KK,L,LL,KC
      DOUBLE PRECISION TEMP
      KK=0
      DO 60 KC=1,NC
        IF (JOB.LE.1) THEN
          LL=ABS(ICA(KC))
          IF (LL.EQ.3.OR.LL.EQ.4) THEN
            TEMP=CZU(KC)-CZL(KC)
          ELSE IF (LL.EQ.1) THEN
            TEMP=-CZL(KC)
          ELSE IF (LL.EQ.2) THEN
            TEMP=CZU(KC)
          ELSE IF (LL.EQ.5) THEN
            TEMP=CZL(KC)
          END IF
          IF (JOB.EQ.1) TEMP=ABS(TEMP)
        ELSE IF (JOB.EQ.2) THEN
          IF (ICA(KC).GE.0) GO TO 60
          TEMP=1.0D0
        ELSE
          TEMP=1.0D0
        END IF
        II=ICG(KC)
        L=ICG(KC+1)-II
        DO 50 IC=1,L
          KK=KK+IC
          I=JCG(II)
          IF (I.LE.0) GO TO 40
          JF=IH(I)
          JJ=II
          K=KK
          DO 30 JC=IC,L
            J=JCG(JJ)
            IF (J.LE.0) GO TO 20
   10       IF (JH(JF).LT.J) THEN
              JF=JF+1
              GO TO 10
            END IF
            B(JF)=B(JF)+TEMP*CH(K)
   20       K=K+JC
            JJ=JJ+1
   30     CONTINUE
   40     II=II+1
   50   CONTINUE
   60 CONTINUE
      RETURN
      END
! SUBROUTINE PFSEB5             ALL SYSTEMS                   06/12/01
! PURPOSE :
! COMPUTATION OF THE SPARSE HESSIAN MATRIX FROM THE PARTITIONED HESSIAN
! MATRIX.
!
! PARAMETERS :
!  II  NC  NUMBER OF CONSTRAINTS.
!  RU  B(M)  ELEMENTS OF THE SPARSE MATRIX B.
!  IO  IH(NF+1)  POINTERS OF THE DIAGONAL ELEMENTS OF B.
!  IO  JH(M)  INDICES OF THE NONZERO ELEMENTS OF B.
!  II  CH(MB)  ELEMENTS OF THE PARTITIONED MATRIX H.
!  II  ICG(NC+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
!  II  JCG(MC)  COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
!  RI  CZ(NC)  VECTOR CONTAINING LAGRANGE MULTIPLIERS FOR CONSTRAINTS.
!  II  JOB  SUBJECTS OF UPDATES. JOB=0-CONSTRAINT FUNCTIONS.
!         JOB=1-CONSTRAINT FUNCTIONS MULTIPLIED BY SIGNS OF THE
!         LAGRANGIAN MULTIPLIERS. JOB-2-ACTIVE TERMS OF THE LAGRANGIAN
!         FUNCTION. JOB-3-ALL TERMS OF THE LAGRANGIAN FUNCTION.
!
      SUBROUTINE PFSEB5 (NC, B, IH, JH, CH, ICG, JCG, CZ, JOB)
      INTEGER NC,IH(*),JH(*),ICG(*),JCG(*),JOB
      DOUBLE PRECISION B(*),CH(*),CZ(*)
      INTEGER I,II,IC,J,JJ,JC,JF,K,KK,L,KC
      DOUBLE PRECISION TEMP
      KK=0
      DO 60 KC=1,NC
        IF (JOB.EQ.0) THEN
          TEMP=CZ(KC)
        ELSE IF (JOB.EQ.1) THEN
          TEMP=ABS(CZ(KC))
        ELSE
          TEMP=1.0D0
        END IF
        II=ICG(KC)
        L=ICG(KC+1)-II
        DO 50 IC=1,L
          KK=KK+IC
          I=JCG(II)
          IF (I.LE.0) GO TO 40
          JF=IH(I)
          JJ=II
          K=KK
          DO 30 JC=IC,L
            J=JCG(JJ)
            IF (J.LE.0) GO TO 20
   10       IF (JH(JF).LT.J) THEN
              JF=JF+1
              GO TO 10
            END IF
            B(JF)=B(JF)+TEMP*CH(K)
   20       K=K+JC
            JJ=JJ+1
   30     CONTINUE
   40     II=II+1
   50   CONTINUE
   60 CONTINUE
      RETURN
      END
! SUBROUTINE PFSED3             ALL SYSTEMS                   07/12/01
! PURPOSE :
! COMPRESSED SPARSE STRUCTURE OF THE HESSIAN MATRIX IS COMPUTED FROM
! THE COORDINATE FORM.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  II  M  NUMBER OF NONZERO ELEMENTS IN THE UPPER PART OF THE SPARSE
!         HESSIAN MATRIX.
!  IU  IH(M+NF)  ON INPUT ROW INDICES OF NONZERO ELEMENTS IN THE FIELD
!         H. ON OUTPUT POSITIONS OF DIAGONAL ELEMENTS IN THE FIELD H.
!  II  JH(M+NF)  COLUMN INDICES OF NONZERO ELEMENTS IN THE FIELD H.
!  IO  IER  ERROR MESAGE. IER=0-THE STANDARD INPUT DATA ARE CORRECT.
!         IER=1-ERROR IN THE ARRAY IH. IER=2-ERROR IN THE ARRAY JH.
!
      SUBROUTINE PFSED3 (NF, M, IH, JH, IER)
      INTEGER NF,M,IH(*),JH(*),IER
      INTEGER I,J,K,L,LL
      IER=0
      DO 10 J=1,M
        IF (IH(J).GT.JH(J)) THEN
          K=IH(J)
          IH(J)=JH(J)
          JH(J)=K
        END IF
   10 CONTINUE
      DO 20 I=1,NF
        IH(M+I)=I
        JH(M+I)=I
   20 CONTINUE
      CALL MXVSR7 (M+NF, IH, JH)
      IF (IH(1).LT.1.OR.IH(M+NF).GT.NF) THEN
        IER=1
        RETURN
      END IF
      K=1
      DO 30 J=1,M+NF
        IF (IH(J).EQ.K) THEN
          IH(K)=J
          K=K+1
        END IF
   30 CONTINUE
      IH(K)=J
      LL=0
      DO 50 I=1,NF
        K=IH(I)
        L=IH(I+1)-K
        IF (L.GT.0) THEN
          CALL MXVSRT (L, JH(K))
          IF (JH(K).LT.1.OR.JH(K+L-1).GT.NF) THEN
            IER=2
            RETURN
          END IF
        END IF
        IH(I)=IH(I)-LL
        DO 40 J=1,L
          IF (J.GT.1.AND.JH(K).EQ.JH(K-1)) THEN
            LL=LL+1
          ELSE
            JH(K-LL)=JH(K)
          END IF
          K=K+1
   40   CONTINUE
   50 CONTINUE
      IH(NF+1)=IH(NF+1)-LL
      M=IH(NF+1)-1
      RETURN
      END
! SUBROUTINE PFSET2             ALL SYSTEMS                   97/12/01
! PURPOSE :
! COMPUTATION OF THE NUMBER OF NONZERO ELEMENTS OF THE SPARSE
! HESSIAN MATRIX STORED IN THE BLOCKED FORM.
!
! PARAMETERS :
!  II  NA  NUMBER OF APPROXIMATED FUNCTIONS.
!  II  MB  NUMBER OF NONZERO ELEMENTS OF THE PARTITIONED HESSIAN MATRIX
!  II  MC  MAXIMUM NUMBER OF ELEMENTS OF THE PARTIAL HESSIAN MATRIX.
!  RI  IAG(NA+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE SPARSE
!         JACOBIAN MATRIX.
!
      SUBROUTINE PFSET2 (NA, MB, MC, IAG)
      INTEGER NA,MB,MC,IAG(*)
      INTEGER K,L,KA
      MB=0
      MC=0
      DO 10 KA=1,NA
        K=IAG(KA)
        L=IAG(KA+1)-K
        MB=MB+L*(L+1)/2
        MC=MAX(MC,L*(L+1)/2)
   10 CONTINUE
      RETURN
      END
! SUBROUTINE PFSET3             ALL SYSTEMS                   97/12/01
! PURPOSE :
! COMPUTATION OF THE SPARSE STRUCTURE OF THE HESSIAN MATRIX FROM THE
! SPARSE STRUCTURE OF THE JACOBIAN MATRIX.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  II  NA  NUMBER OF APPROXIMATED FUNCTIONS.
!  IO  M  NUMBER OF NONZERO ELEMENTS OF THE HESSIAN MATRIX.
!  II  MMAX  DECLARED LENGHT OF THE ARRAYS H AND JH.
!  IO  IH(NF+1)  POINTERS OF THE DIAGONAL ELEMENTS OF H.
!  IO  JH(M)  INDICES OF THE NONZERO ELEMENTS OF H.
!  II  IAG(NA+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
!  II  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
!  IU  ITERM  TERMINATION INDICATOR.
!
      SUBROUTINE PFSET3 (NF, NA, M, MMAX, IH, JH, IAG, JAG, ITERM)
      INTEGER NF,NA,M,MMAX,IH(*),JH(*),IAG(*),JAG(*),ITERM
      INTEGER I,J,JF,JA,K,LF,LA,KA
      M=IH(NF+1)-1
      IF (M.GT.MMAX) THEN
        ITERM=-40
        RETURN
      END IF
      DO 60 KA=1,NA
        LA=IAG(KA+1)-1
        DO 50 K=IAG(KA),LA
          I=JAG(K)
          JF=IH(I)
          LF=IH(I+1)-1
          DO 40 JA=K,LA
            J=JAG(JA)
   10       IF (JH(JF).LT.J.AND.JF.LE.LF) THEN
              JF=JF+1
              IF (JF.LE.LF) GO TO 10
            END IF
            IF (JH(JF).GT.J.OR.JF.GT.LF) THEN
              DO 20 J=I+1,NF+1
                IH(J)=IH(J)+1
   20         CONTINUE
              DO 30 J=M,JF,-1
                JH(J+1)=JH(J)
   30         CONTINUE
              JH(JF)=JAG(JA)
              JF=JF+1
              LF=LF+1
              M=M+1
              IF (M.GT.MMAX) THEN
                ITERM=-40
                RETURN
              END IF
            END IF
   40     CONTINUE
   50   CONTINUE
   60 CONTINUE
      RETURN
      END
! SUBROUTINE PFSET4             ALL SYSTEMS                   98/12/01
! PURPOSE :
! COMPUTATION OF THE SPARSE HESSIAN MATRIX FROM THE PARTITIONED HESSIAN
! MATRIX.
!
! PARAMETERS :
!  II  NA  NUMBER OF APPROXIMATED FUNCTIONS.
!  RU  B(M)  ELEMENTS OF THE SPARSE MATRIX B.
!  IO  IH(NF+1)  POINTERS OF THE DIAGONAL ELEMENTS OF B.
!  IO  JH(M)  INDICES OF THE NONZERO ELEMENTS OF B.
!  II  AH(MB)  ELEMENTS OF THE PARTITIONED MATRIX H.
!  II  IAG(NA+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
!  II  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
!
      SUBROUTINE PFSET4 (NA, B, IH, JH, AH, IAG, JAG)
      INTEGER NA,IH(*),JH(*),IAG(*),JAG(*)
      DOUBLE PRECISION B(*),AH(*)
      INTEGER I,II,IA,J,JJ,JA,JF,K,KK,L,KA
      KK=0
      DO 60 KA=1,NA
        II=IAG(KA)
        L=IAG(KA+1)-II
        DO 50 IA=1,L
          KK=KK+IA
          I=JAG(II)
          IF (I.LE.0) GO TO 40
          JF=IH(I)
          JJ=II
          K=KK
          DO 30 JA=IA,L
            J=JAG(JJ)
            IF (J.LE.0) GO TO 20
   10       IF (JH(JF).LT.J) THEN
              JF=JF+1
              GO TO 10
            END IF
            B(JF)=B(JF)+AH(K)
   20       K=K+JA
            JJ=JJ+1
   30     CONTINUE
   40     II=II+1
   50   CONTINUE
   60 CONTINUE
      RETURN
      END
! FUNCTION PNFUZ1               ALL SYSTEMS                   01/09/22
! PURPOSE :
! COMPUTATION OF LOWER AND UPPER LAGRANGE MULTIPLIERS.
!
! PARAMETERS :
!  RO  Z  SLACK VARIABLE IN THE NONLINEAR PROGRAMMING FORMULATION OF
!         A MINIMAX PROBLEM.
!  II  NA  NUMBER OF APPROXIMATED FUNCTIONS.
!  RI  RPF3  BARRIER PARAMETER.
!  RO  AF(NA)  VECTOR CONTAINING VALUES OF THE APPROXIMATED
!         FUNCTIONS.
!  RA  AZL(NA)  VECTOR OF LOWER LAGRANGE MULTIPLIERS.
!  RA  AZU(NA)  VECTOR OF UPPER LAGRANGE MULTIPLIERS.
!  II  IEXT  TYPE OF MINIMAX. IEXT<0-MINIMIZATION OF THE MAXIMUM
!         PARTIAL VALUE. IEXT-0-MINIMIZATION OF THE MAXIMUM PARTIAL
!         ABSOLUTE VALUE. IEXT>0-MAXIMIZATION OF THE MINIMUM PARTIAL
!         VALUE.
!
      FUNCTION PNFUZ1 (Z, NA, RPF3, AF, AZL, AZU, IEXT)
      INTEGER NA,IEXT
      DOUBLE PRECISION Z,RPF3,AF(*),AZL(*),AZU(*),PNFUZ1
      INTEGER KA
      PNFUZ1=1.0D0
      DO 10 KA=1,NA
        IF (IEXT.LE.0) THEN
          AZU(KA)=RPF3/(Z-AF(KA))
          PNFUZ1=PNFUZ1-AZU(KA)
        END IF
        IF (IEXT.GE.0) THEN
          AZL(KA)=RPF3/(Z+AF(KA))
          PNFUZ1=PNFUZ1-AZL(KA)
        END IF
   10 CONTINUE
      RETURN
      END
! SUBROUTINE PNINT1                ALL SYSTEMS                91/12/01
! 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)
      DOUBLE PRECISION RL,RU,FL,FU,PL,PU,R
      INTEGER MODE,MTYP,MERR,NTYP
      DOUBLE PRECISION A,B,C,D,DIS,DEN
      DOUBLE PRECISION C1L,C1U,C2L,C2U,C3L
      PARAMETER  (C1L=1.1D0,C1U=1.0D3,C2L=1.0D-2,C2U=0.9D0,C3L=0.1D0)
      MERR=0
      IF (MODE.LE.0) RETURN
      IF (PL.GE.0.0D0) 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=4.0D0*RU
            RETURN
          ELSE
            R=0.5D0*(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=2.0D0*(1.0D0-A)
        ELSE IF (NTYP.EQ.3) THEN
!
!     QUADRATIC EXTRAPOLATION OR INTERPOLATION WITH TWO DIRECTIONAL
!     DERIVATIVES
!
          DEN=1.0D0-B
        ELSE IF (NTYP.EQ.4) THEN
!
!     CUBIC EXTRAPOLATION OR INTERPOLATION
!
          C=B-2.0D0*A+1.0D0
          D=B-3.0D0*A+2.0D0
          DIS=D*D-3.0D0*C
          IF (DIS.LT.0.0D0) GO TO 10
          DEN=D+SQRT(DIS)
        ELSE IF (NTYP.EQ.5) THEN
!
!     CONIC EXTRAPOLATION OR INTERPOLATION
!
          DIS=A*A-B
          IF (DIS.LT.0.0D0) GO TO 10
          DEN=A+SQRT(DIS)
          IF (DEN.LE.0.0D0) GO TO 10
          DEN=1.0D0-B*(1.0D0/DEN)**3
        END IF
        IF (MODE.EQ.1.AND.DEN.GT.0.0D0.AND.DEN.LT.1.0D0) 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.1.0D0) THEN
!
!     INTERPOLATION ACCEPTED
!
          R=RL+(RU-RL)/DEN
          IF (RL.EQ.0.0D0) 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
! 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)
      DOUBLE PRECISION RO,RL,RU,RI,FO,FL,FU,FI,PO,R
      INTEGER MODE,MTYP,MERR,NTYP
      DOUBLE PRECISION AL,AU,AI,DEN,DIS
      LOGICAL L1,L2
      DOUBLE PRECISION ZERO,HALF,ONE,TWO,THREE,FOUR,C1L,C1U,C2L,C2U,C3L
      PARAMETER  (ZERO=0.0D0,HALF=0.5D0,ONE=1.0D0,TWO=2.0D0,THREE=3.0D0,
     &FOUR=4.0D0,C1L=1.1D0,C1U=1.0D3,C2L=1.0D-2,C2U=0.9D0,C3L=1.0D-1)
      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 PNNEQ1                ALL SYSTEMS                92/12/01
! PURPOSE :
! SOLUTION OF A SINGLE NONLINEAR EQUATION.
!
! PARAMETERS :
!  RI  AA  LEFT ENDPOINT OF THE INTERVAL.
!  RI  BB  RIGHT ENDPOINT OF THE INTERVAL.
!  RO  X  COMPUTED SOLUTION POINT.
!  RO  F  COMPUTED VALUE OF THE NONLINEAR FUNCTION.
!  RF  FUN  EXTERNAL FUNCTION.
!  RI  EPSX  REQUIRED PRECISION FOR THE SOLUTION POINT.
!  RI  EPSF REQUIRED PRECISION FOR THE NONLINEAR FUNCTION.
!  IO  IC NUMBER OF ITERATIONS.
!  IO  IE ERROR SPECIFICATION.
!  IU  ISYS  CONTROL PARAMETER.
!
! METHOD :
! D.LEE: THREE NEW RAPIDLY CONVERGENT ALGORITHMS FOR FINDING A ZERO
! OF A FUNCTION, SIAM J. SCI. STAT. COMPUT. 6 (1985) 193-208.
!
      SUBROUTINE PNNEQ1 (AA, BB, X, F, EPSX, EPSF, IC, IE, ISYS)
      DOUBLE PRECISION AA,BB,X,F,EPSX,EPSF
      INTEGER IC,IE,ISYS
      INTEGER ITER,ITMAX,K,L
      DOUBLE PRECISION FA,FB,X1,X2,X3,F1,F2,F3,R,R1,RA,RB,D,D1,A,B,C,Z,
     &W,FW,GW,DEL,DDL,F21,F32
      DOUBLE PRECISION ZERO,ONE,TWO,THREE,FOUR,HALF,CON
      PARAMETER  (ZERO=0.0D0,ONE=1.0D0,TWO=2.0D0,THREE=3.0D0,FOUR=4.0D0,
     &HALF=0.5D0,CON=0.1D0)
      SAVE  A,B,C,FA,FB,X1,X2,X3,F1,F2,F3,R,D,FW
      SAVE  L,ITER,ITMAX
      GO TO (10,20,30,40,60), ISYS+1
   10 IE=0
      ITMAX=IC
      IF (ITMAX.LE.0) ITMAX=100
      X=AA
      ISYS=1
      IC=1
      RETURN
   20 CONTINUE
      IF (ABS(F).LE.EPSF) GO TO 70
      FA=F
      X=BB
      ISYS=2
      IC=2
      RETURN
   30 CONTINUE
      IF (ABS(F).LE.EPSF) GO TO 70
      FB=F
      IF (FA*FB.GT.0.0D0) THEN
        X=AA
        F=FA
        IE=-2
        GO TO 70
      END IF
      X1=AA
      F1=FA
      X=HALF*(AA+BB)
      ISYS=3
      IC=3
      RETURN
   40 CONTINUE
      X2=X
      F2=F
      IF (F1*F2.GT.0.0D0) THEN
        X3=X1
        F3=F1
        X1=BB
        F1=FB
      ELSE
        X3=BB
        F3=FB
      END IF
      L=0
      D=0.0D0
      R=0.0D0
      ITER=1
   50 D1=D
      R1=R
      D=ABS(X1-X2)
      IF (ABS(F1).LT.ABS(F2)) THEN
        X=X1
        F=F1
      ELSE
        X=X2
        F=F2
      END IF
      DEL=EPSX*(ABS(X)+ONE)
      IF (ABS(F).LE.EPSF.OR.D.LE.TWO*DEL) GO TO 70
      Z=X1+HALF*(X2-X1)
      DDL=MAX(CON*D,DEL)
      IF (THREE*D.LE.TWO*D1) THEN
        K=0
      ELSE
        K=1
      END IF
      IF (X2.EQ.X1) THEN
        F21=0.0D0
      ELSE
        F21=(F2-F1)/(X2-X1)
      END IF
      IF (X3.EQ.X2) THEN
        F32=0.0D0
      ELSE
        F32=(F3-F2)/(X3-X2)
      END IF
      A=(F32-F21)/(X3-X1)
      B=A*(X2+X1)-F21
      C=F2-(A*X2-B)*X2
      IF (ABS(A).LE.1.0D-10) THEN
        R=(F2*X1-F1*X2)/(F2-F1)
      ELSE
        R=B*B-FOUR*A*C
        IF (R.LT.0.0D0) THEN
          R=(F2*X1-F1*X2)/(F2-F1)
        ELSE
          R=SQRT(R)
          RA=HALF*(B+R)/A
          RB=HALF*(B-R)/A
          IF (ABS(RA-Z).LE.ABS(RB-Z)) THEN
            R=RA
          ELSE
            R=RB
          END IF
          IF (R.LE.MIN(X1,X2).OR.R.GE.MAX(X1,X2)) THEN
            R=(F2*X1-F1*X2)/(F2-F1)
          END IF
        END IF
      END IF
      IF (L.GE.2) THEN
        W=R
        IF (ABS(W-X).LT.DEL) W=X+DEL*SIGN(ONE,Z-X)
      ELSE IF (K.EQ.1.OR.ABS(R-X).GE.ABS(Z-X)) THEN
        W=Z
      ELSE
        W=R+HALF*ABS(R-R1)*SIGN(ONE,R-X)
        IF (ABS(W-X).LT.DDL) W=X+DDL*SIGN(ONE,Z-X)
        IF (ABS(W-X).GE.ABS(Z-X)) W=Z
      END IF
      X=W
      FW=F
      ISYS=4
      IC=IC+1
      RETURN
   60 CONTINUE
      GW=(A*X-B)*X+C
      IF (ABS(F-GW).LE.1.0D-1*ABS(FW).OR.ABS(FW).LE.1.0D-3*MAX(ABS(F1),
     &ABS(F2)).AND.L.GE.2) THEN
        L=L+1
      ELSE
        L=0
      END IF
      IF (F*SIGN(ONE,F1).GE.0.0D0) THEN
        IF (D.LE.ABS(X3-X)) THEN
          X3=X1
          F3=F1
          X1=X2
          F1=F2
          X2=X
          F2=F
        ELSE
          X1=X
          F1=F
        END IF
      ELSE
        X3=X2
        F3=F2
        X2=X
        F2=F
      END IF
      ITER=ITER+1
      IF (ITER.LE.ITMAX) GO TO 50
      IE=-1
   70 ISYS=0
      RETURN
      END
! SUBROUTINE PNSTEP                ALL SYSTEMS                89/12/01
! PURPOSE :
! DETERMINATION OF A SCALING FACTOR FOR THE BOUNDARY STEP.
!
! PARAMETERS :
!  RI  DEL  MAXIMUM STEPSIZE.
!  RI  A  INPUT PARAMETER.
!  RI  B  INPUT PARAMETER.
!  RI  C  INPUT PARAMETER.
!  RO  ALF  SCALING FACTOR FOR THE BOUNDARY STEP SUCH THAT
!         A**2+2*B*ALF+C*ALF**2=DEL**2.
!
      SUBROUTINE PNSTEP (DEL, A, B, C, ALF)
      DOUBLE PRECISION DEL,A,B,C,ALF
      DOUBLE PRECISION DEN,DIS
      ALF=0.0D0
      DEN=(DEL+A)*(DEL-A)
      IF (DEN.LE.0.0D0) RETURN
      DIS=B*B+C*DEN
      IF (B.GE.0.0D0) THEN
        ALF=DEN/(SQRT(DIS)+B)
      ELSE
        ALF=(SQRT(DIS)-B)/C
      END IF
      RETURN
      END
! SUBROUTINE PNSTP4                ALL SYSTEMS                99/12/01
! 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  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 PNSTP4 (N, MA, MAL, X, AF, AG, AY, S, F, DF, T, TB,
     &ETA5, ETA9, MOS3)
      DOUBLE PRECISION DF,ETA5,ETA9,F,T,TB
      INTEGER MA,MAL,MOS3,N
      DOUBLE PRECISION AF(*),AG(*),AY(*),S(*),X(*)
      DOUBLE PRECISION ALF,ALFL,ALFR,BET,BETL,BETR,DX,Q,R,W
      INTEGER I,J,JN,K,L,LQ
      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
! 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)
      DOUBLE PRECISION DF,ETA5,ETA9,F,T,TB
      INTEGER MA,MAL,MOS3,N
      DOUBLE PRECISION AF(*),AG(*),AY(*),S(*),X(*)
      DOUBLE PRECISION ALF,ALFL,ALFR,BET,BETL,BETR,DX,Q,R,W
      INTEGER I,J,JN,K,L
      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 PP0BA1             ALL SYSTEMS                 05/12/01
! PURPOSE :
! EVALUATION OF THE BARRIER FUNCTION FOR THE SUM OF ABSOLUTE VALUES.
!
! PARAMETERS :
!  II  NA  NUMBER OF APPROXIMATED FUNCTIONS.
!  RI  AS(NA)  SUM OF ABSOLUTE VALUE SLACK VARIABLES.
!  RI  RPF3  BARRIER COEFFICIENT.
!  RO  F  VALUE OF THE BARRIER FUNCTION.
!
      SUBROUTINE PP0BA1 (NA, AS, RPF3, F)
      INTEGER NA
      DOUBLE PRECISION AS(*),RPF3,F
      INTEGER KA
      F=-DBLE(NA)*RPF3*LOG(2.0D0*RPF3)
      DO 10 KA=1,NA
        F=F+AS(KA)-RPF3*LOG(AS(KA))
   10 CONTINUE
      RETURN
      END
! SUBROUTINE PP0BX1             ALL SYSTEMS                 05/12/01
! PURPOSE :
! EVALUATION OF THE BARRIER FUNCTION FOR THE MINIMAX OPTIMIZATION.
!
! PARAMETERS :
!  II  NA  NUMBER OF APPROXIMATED FUNCTIONS.
!  RI  Z  MINIMAX SLACK VARIABLE.
!  RI  AF(NA)  VECTOR CONTAINING VALUES OF APPROXIMATED FUNCTIONS.
!  RO  F  VALUE OF THE BARRIERY FUNCTION.
!  RI  FF  VALUE OF THE THE OBJECTIVE FUNCTION.
!  RI  PAR  PARAMETER OF THE BEN-TAL BARRIER FUNCTION.
!  RI  RPF3  BARRIER COEFFICIENT.
!  II  MEP  MERIT FUNCTION USED. MEP=1-LOGARITHMIC BARIER FUNCTION.
!         MEP=2-BEN-TAL BARRIER FUNCTION. MEP=3-COMPOSITE BARRIER
!         FUNCTION.
!  II  IEXT  KIND OF THE MINIMAX APPROXIMATION. IEXT=0-CHEBYSHEV
!         APPROXIMATION. IEXT=-1-MINIMAX. IEXT=+1-MAXIMIN.
!
      SUBROUTINE PP0BX1 (NA, Z, AF, F, FF, PAR, RPF3, MEP, IEXT)
      INTEGER NA,MEP,IEXT
      DOUBLE PRECISION Z,AF(*),PAR,RPF3,F,FF
      DOUBLE PRECISION FA
      INTEGER KA
      IF (Z.LE.FF) THEN
        F=1.0D60
      ELSE
        F=Z
        IF (MEP.EQ.1) THEN
          DO 10 KA=1,NA
            FA=AF(KA)
            IF (IEXT.LE.0) THEN
              F=F-RPF3*LOG(Z-FA)
            END IF
            IF (IEXT.GE.0) THEN
              F=F-RPF3*LOG(Z+FA)
            END IF
   10     CONTINUE
        ELSE IF (MEP.EQ.2) THEN
          DO 20 KA=1,NA
            FA=AF(KA)
            IF (IEXT.LE.0) THEN
              IF (Z-FA.LE.PAR) THEN
                F=F-RPF3*LOG(Z-FA)
              ELSE
                F=F+(2.0D0-0.5D0*PAR/(Z-FA))*RPF3*PAR/(Z-FA)
              END IF
            END IF
            IF (IEXT.GE.0) THEN
              IF (Z+FA.LE.PAR) THEN
                F=F-RPF3*LOG(Z+FA)
              ELSE
                F=F+(2.0D0-0.5D0*PAR/(Z+FA))*RPF3*PAR/(Z+FA)
              END IF
            END IF
   20     CONTINUE
        ELSE IF (MEP.EQ.3) THEN
          DO 30 KA=1,NA
            FA=AF(KA)
            IF (IEXT.LE.0) THEN
              F=F+RPF3*LOG(1.0D0/(Z-FA)+1.0D0)
            END IF
            IF (IEXT.GE.0) THEN
              F=F+RPF3*LOG(1.0D0/(Z+FA)+1.0D0)
            END IF
   30     CONTINUE
        ELSE IF (MEP.EQ.4) THEN
          DO 40 KA=1,NA
            FA=AF(KA)
            IF (IEXT.LE.0) THEN
              F=F+RPF3*RPF3/(Z-FA)
            END IF
            IF (IEXT.GE.0) THEN
              F=F+RPF3*RPF3/(Z+FA)
            END IF
   40     CONTINUE
        END IF
      END IF
      RETURN
      END
! SUBROUTINE PP1MX3             ALL SYSTEMS                 05/12/01
! PURPOSE :
! COMPUTATION OF THE VALUE AND THE GRADIENT OF THE LAGRANGIAN FUNCTION
! FOR THE MINIMAX OPTIMIZATION.
!
! PARAMETERS:
!  II  NF  NUMBER OF VARIABLES.
!  II  NA  NUMBER OF APPROXIMATED FUNCTIONS.
!  RI  X(NF)  VECTOR OF VARIABLES.
!  RI  GA(NF)  GRADIENT OF THE APPROXIMATED FUNCTION.
!  RI  AG(IAG(N+1)-1)  SPARSE RECTANGULAR MATRIX WHICH IS USED FOR THE
!         DIRECTION VECTOR DETERMINATION.
!  II  IAG(N+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
!  II  JAG(MA) COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
!  RO  G(NF)  GRADIENT OF THE OBJECTIVE FUNCTION.
!  RI  AZL(NA)  LOWER LAGRANGE MULTIPLIERS.
!  RI  AZU(NA)  UPPER LAGRANGE MULTIPLIERS.
!  RI  FA  VALUE OF THE SELECTED FUNCTION.
!  RI  AF(NA)  VALUES OF THE APPROXIMATED FUNCTIONS.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  II  KD  DEGREE OF REQUIRED DERIVATIVES.
!  IO  LD  DEGREE OF PREVIOUSLY COMPUTED DERIVATIVES.
!  IU  NFV  NUMBER OF OBJECTIVE FUNCTION VALUES COMPUTED.
!  IU  NFG  NUMBER OF OBJECTIVE FUNCTION GRADIENTS COMPUTED.
!  II  ISNA  INDICATOR FOR STORING ELEMENTAL FUNCTION VALUES AND
!         GRADIENTS. ISNA=0-STORING SUPPRESSED. ISNA=1-STORING
!         ELEMENTAL FUNCTION VALUES. ISNA=2-STORING ELEMENTAL
!         FUNCTION VALUES AND GRADIENTS.
!  II  IEXT  TYPE OF MINIMAX. IEXT=0-MINIMIZATION OF THE MAXIMUM VALUE.
!         IEXT=1-MINIMIZATION OF THE MAXIMUM ABSOLUTE VALUE.
!
! SUBPROGRAMS USED :
!  SE  FUN  COMPUTATION OF THE VALUE OF THE APPROXIMATED FUNCTION.
!  SE  DFUN  COMPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION.
!  S   MXVSET  INITIATION OF A VECTOR.
!
      SUBROUTINE PP1MX3 (NF, NA, X, GA, AG, IAG, JAG, G, AZL, AZU, FA,
     &AF, F, KD, LD, NFV, NFG, ISNA, IEXT)
      INTEGER NF,NA,IAG(*),JAG(*),KD,LD,NFV,NFG,ISNA,IEXT
      DOUBLE PRECISION X(*),GA(*),AG(*),G(*),AZL(*),AZU(*),FA,AF(*),F
      INTEGER J,JP,K,KA,L
      IF (KD.LE.LD) RETURN
      IF (KD.GE.0.AND.LD.LT.0) THEN
        NFV=NFV+1
      END IF
      IF (KD.GE.1.AND.LD.LT.1) THEN
        CALL MXVSET (NF, 0.0D0, G)
        NFG=NFG+1
      END IF
      DO 30 KA=1,NA
        IF (LD.GE.0) GO TO 10
        CALL FUN (NF, KA, X, FA)
        IF (ISNA.GE.1) AF(KA)=FA
        IF (IEXT.EQ.0) THEN
          IF (KA.EQ.1) F=ABS(FA)
          F=MAX(F,ABS(FA))
        ELSE IF (IEXT.LT.0) THEN
          IF (KA.EQ.1) F=FA
          F=MAX(F,FA)
        ELSE IF (IEXT.GT.0) THEN
          IF (KA.EQ.1) F=-FA
          F=MAX(F,-FA)
        END IF
   10   IF (KD.LT.1) GO TO 30
        IF (LD.GE.1) GO TO 30
        CALL DFUN (NF, KA, X, GA)
        K=IAG(KA)
        L=IAG(KA+1)-K
        DO 20 J=1,L
          JP=ABS(JAG(K))
          IF (IEXT.EQ.0) THEN
            G(JP)=G(JP)+(AZU(KA)-AZL(KA))*GA(JP)
          ELSE IF (IEXT.LT.0) THEN
            G(JP)=G(JP)+AZU(KA)*GA(JP)
          ELSE IF (IEXT.GT.0) THEN
            G(JP)=G(JP)-AZL(KA)*GA(JP)
          END IF
          IF (ISNA.GE.2) AG(K)=GA(JP)
          K=K+1
   20   CONTINUE
   30 CONTINUE
      RETURN
      END
! SUBROUTINE PP1SA3             ALL SYSTEMS                 05/12/01
! PURPOSE :
! COMPUTATION OF THE VALUE AND THE GRADIENT OF THE LAGRANGIAN FUNCTION
! FOR THE SUM OF ABSOLUTE VALUES.
!
! PARAMETERS:
!  II  NF  NUMBER OF VARIABLES.
!  II  NA  NUMBER OF APPROXIMATED FUNCTIONS.
!  RI  X(NF)  VECTOR OF VARIABLES.
!  RI  GA(NF)  GRADIENT OF THE APPROXIMATED FUNCTION.
!  RI  AG(IAG(N+1)-1)  SPARSE RECTANGULAR MATRIX WHICH IS USED FOR THE
!         DIRECTION VECTOR DETERMINATION.
!  II  IAG(N+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
!  II  JAG(MA) COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
!  RO  G(NF)  GRADIENT OF THE OBJECTIVE FUNCTION.
!  RI  AZ(NA)  VECTOR OF LAGRANGE MULTIPLIERS.
!  RI  FA  VALUE OF THE SELECTED FUNCTION.
!  RI  AF(NA)  VALUES OF THE APPROXIMATED FUNCTIONS.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  II  KD  DEGREE OF REQUIRED DERIVATIVES.
!  IO  LD  DEGREE OF PREVIOUSLY COMPUTED DERIVATIVES.
!  IU  NFV  NUMBER OF OBJECTIVE FUNCTION VALUES COMPUTED.
!  IU  NFG  NUMBER OF OBJECTIVE FUNCTION GRADIENTS COMPUTED.
!  II  ISNA  INDICATOR FOR STORING ELEMENTAL FUNCTION VALUES AND
!         GRADIENTS. ISNA=0-STORING SUPPRESSED. ISNA=1-STORING
!         ELEMENTAL FUNCTION VALUES. ISNA=2-STORING ELEMENTAL
!         FUNCTION VALUES AND GRADIENTS.
!
! SUBPROGRAMS USED :
!  SE  FUN  COMPUTATION OF THE VALUE OF THE APPROXIMATED FUNCTION.
!  SE  DFUN  COMPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION.
!  S   MXVSET  INITIATION OF A VECTOR.
!
      SUBROUTINE PP1SA3 (NF, NA, X, GA, AG, IAG, JAG, G, AZ, FA, AF, F,
     &KD, LD, NFV, NFG, ISNA)
      INTEGER NF,NA,IAG(*),JAG(*),KD,LD,NFV,NFG,ISNA
      DOUBLE PRECISION X(*),GA(*),AG(*),G(*),AZ(*),FA,AF(*),F
      INTEGER J,JP,K,KA,L
      IF (KD.LE.LD) RETURN
      IF (KD.GE.0.AND.LD.LT.0) THEN
        F=0.0D0
        NFV=NFV+1
      END IF
      IF (KD.GE.1.AND.LD.LT.1) THEN
        CALL MXVSET (NF, 0.0D0, G)
        NFG=NFG+1
      END IF
      DO 30 KA=1,NA
        IF (LD.GE.0) GO TO 10
        CALL FUN (NF, KA, X, FA)
        IF (ISNA.GE.1) AF(KA)=FA
        F=F+ABS(FA)
   10   IF (KD.LT.1) GO TO 30
        IF (LD.GE.1) GO TO 30
        CALL DFUN (NF, KA, X, GA)
        K=IAG(KA)
        L=IAG(KA+1)-K
        DO 20 J=1,L
          JP=ABS(JAG(K))
          G(JP)=G(JP)+AZ(KA)*GA(JP)
          IF (ISNA.GE.2) AG(K)=GA(JP)
          K=K+1
   20   CONTINUE
   30 CONTINUE
      RETURN
      END
! SUBROUTINE PPLAG1             ALL SYSTEMS                 05/12/01
! PURPOSE :
! COMPUTATION OF THE LAGRANGE MULTIPLIERS FOR THE SUM OF ABSOLUTE
! VALUES.
!
! PARAMETERS :
!  II  NA  NUMBER OF APPROXIMATED FUNCTIONS.
!  RI  AF(NA)  VECTOR CONTAINING VALUES OF APPROXIMATED FUNCTIONS.
!  RA  AS(NA)  AUXILIARY ARRAY.
!  RO  AZ(NA)  LAGRANGE MULTIPLIERS.
!  RI  RPF3  BARRIER COEFFICIENT.
!
      SUBROUTINE PPLAG1 (NA, AF, AS, AZ, RPF3)
      INTEGER NA
      DOUBLE PRECISION AF(*),AS(*),AZ(*),RPF3
      DOUBLE PRECISION FA
      INTEGER KA
      DO 10 KA=1,NA
        FA=AF(KA)
        AS(KA)=RPF3+SQRT(RPF3**2+FA**2)
        AZ(KA)=FA/AS(KA)
   10 CONTINUE
      RETURN
      END
! SUBROUTINE PS0G01                ALL SYSTEMS                97/12/01
! PURPOSE :
! SIMPLE SEARCH WITH TRUST REGION UPDATE.
!
! PARAMETERS :
!  RO  R  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  PP  QUADRATIC PART OF THE PREDICTED FUNCTION VALUE.
!  RU  XDEL  TRUST REGION BOUND.
!  RO  XDELO  PREVIOUS TRUST REGION BOUND.
!  RI  XMAX MAXIMUM STEPSIZE.
!  RI  RMAX  MAXIMUM VALUE OF THE STEPSIZE PARAMETER.
!  RI  SNORM  EUCLIDEAN NORM OF THE DIRECTION VECTOR.
!  RI  BET1  LOWER BOUND FOR STEPSIZE REDUCTION.
!  RI  BET2  UPPER BOUND FOR STEPSIZE REDUCTION.
!  RI  GAM1  LOWER BOUND FOR STEPSIZE EXPANSION.
!  RI  GAM2  UPPER BOUND FOR STEPSIZE EXPANSION.
!  RI  EPS4  FIRST TOLERANCE FOR RATIO DF/DFPRED. STEP BOUND IS
!         DECREASED IF DF/DFPRED<EPS4.
!  RI  EPS5  SECOND TOLERANCE FOR RATIO DF/DFPRED. STEP BOUND IS
!         INCREASED IF IT IS ACTIVE AND DF/DFPRED>EPS5.
!  II  KD  DEGREE OF REQUIRED DERIVATIVES.
!  IO  LD  DEGREE OF PREVIOUSLY COMPUTED DERIVATIVES OF OBJECTIVE
!          FUNCTION.
!  IU  IDIR INDICATOR FOR DIRECTION DETERMINATION.
!         IDIR=0-BASIC DETERMINATION. IDIR=1-DETERMINATION
!         AFTER STEPSIZE REDUCTION. IDIR=2-DETERMINATION AFTER
!         STEPSIZE EXPANSION.
!  IO  ITERS  TERMINATION INDICATOR. ITERS=0-ZERO STEP. ITERS=1-STEP
!         BOUND WAS DECREASED. ITERS=2-STEP BOUND WAS UNCHANGED.
!         ITERS=3-STEP BOUND WAS INCREASED. ITERS=6-FIRST STEPSIZE.
!  II  ITERD  CAUSE OF TERMINATION IN THE DIRECTION DETERMINATION.
!         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  MAXST  MAXIMUM STEPSIZE INDICATOR. MAXST=0 OR MAXST=1 IF MAXIMUM
!         STEPSIZE WAS NOT OR WAS REACHED.
!  IO  NRED  ACTUAL NUMBER OF EXTRAPOLATIONS OR INTERPOLATIONS.
!  II  MRED  MAXIMUM NUMBER OF EXTRAPOLATIONS OR INTERPOLATIONS.
!  II  KTERS  TERMINATION SELECTION. KTERS=1-NORMAL TERMINATION.
!         KTERS=6-FIRST STEPSIZE.
!  II  MES1  SWITCH FOR EXTRAPOLATION. MES1=1-CONSTANT INCREASING OF
!         THE INTERVAL. MES1=2-EXTRAPOLATION SPECIFIED BY THE PARAMETER
!         MES. MES1=3 SUPPRESSED EXTRAPOLATION.
!  II  MES2  SWITCH FOR TERMINATION. MES2=1-NORMAL TERMINATION.
!         MES2=2-TERMINATION AFTER AT LEAST TWO STEPS (ASYMPTOTICALLY
!         PERFECT LINE SEARCH).
!  II  MES3  SAFEGUARD AGAINST ROUNDING ERRORS. MES3=0-SAFEGUARD
!         SUPPRESSED. MES3=1-FIRST LEVEL OF SAFEGUARD. MES3=2-SECOND
!         LEVEL OF SAFEGUARD.
!  IU  ISYS  CONTROL PARAMETER.
!
! METHOD :
! G.A.SCHULTZ, R.B.SCHNABEL, R.H.BYRD: A FAMILY OF TRUST-REGION-BASED
! ALGORITHMS FOR UNCONSTRAINED MINIMIZATION WITH STRONG GLOBAL
! CONVERGENCE PROPERTIES, SIAM J. NUMER.ANAL. 22 (1985) PP. 47-67.
!
      SUBROUTINE PS0G01 (R, F, FO, PO, PP, XDEL, XDELO, XMAX, RMAX,
     &SNORM, BET1, BET2, GAM1, GAM2, EPS4, EPS5, KD, LD, IDIR, ITERS,
     &ITERD, MAXST, NRED, MRED, KTERS, MES1, MES2, MES3, ISYS)
      INTEGER KD,LD,IDIR,ITERS,ITERD,MAXST,NRED,MRED,KTERS,MES1,MES2,
     &MES3,ISYS
      DOUBLE PRECISION R,F,FO,PO,PP,XDEL,XDELO,XMAX,RMAX,SNORM,BET1,
     &BET2,GAM1,GAM2,EPS4,EPS5
      DOUBLE PRECISION DF,DFPRED
      INTEGER NRED1,NRED2
      SAVE  NRED1,NRED2
      IF (ISYS.EQ.1) GO TO 10
      IF (IDIR.EQ.0) THEN
        NRED1=0
        NRED2=0
      END IF
      IDIR=0
      XDELO=XDEL
!
!     COMPUTATION OF THE NEW FUNCTION VALUE
!
      R=MIN(1.0D0,RMAX)
      KD=0
      LD=-1
      ISYS=1
      RETURN
   10 CONTINUE
      IF (KTERS.LT.0.OR.KTERS.GT.5) THEN
        ITERS=6
      ELSE
        DF=FO-F
        DFPRED=-R*(PO+R*PP)
        IF (DF.LT.EPS4*DFPRED) THEN
!
!     STEP IS TOO LARGE, IT HAS TO BE REDUCED
!
          IF (MES1.EQ.1) THEN
            XDEL=BET2*SNORM
          ELSE IF (MES1.EQ.2) THEN
            XDEL=BET2*MIN(0.5D0*XDEL,SNORM)
          ELSE
            XDEL=0.5D0*PO*SNORM/(PO+DF)
            XDEL=MAX(XDEL,BET1*SNORM)
            XDEL=MIN(XDEL,BET2*SNORM)
          END IF
          ITERS=1
          IF (MES3.LE.1) THEN
            NRED2=NRED2+1
          ELSE
            IF (ITERD.GT.2) NRED2=NRED2+1
          END IF
        ELSE IF (DF.LE.EPS5*DFPRED) THEN
!
!     STEP IS SUITABLE
!
          ITERS=2
        ELSE
!
!     STEP IS TOO SMALL, IT HAS TO BE ENLARGED
!
          IF (MES2.EQ.2) THEN
            XDEL=MAX(XDEL,GAM1*SNORM)
          ELSE IF (ITERD.GT.2) THEN
            XDEL=GAM1*XDEL
          END IF
          ITERS=3
        END IF
        XDEL=MIN(XDEL,XMAX,GAM2*SNORM)
        IF (FO.LE.F) THEN
          IF (NRED1.GE.MRED) THEN
            ITERS=-1
          ELSE
            IDIR=1
            ITERS=0
            NRED1=NRED1+1
          END IF
        END IF
      END IF
      MAXST=0
      IF (XDEL.GE.XMAX) MAXST=1
      IF (MES3.EQ.0) THEN
        NRED=NRED1
      ELSE
        NRED=NRED2
      END IF
      ISYS=0
      RETURN
      END
! SUBROUTINE PS0L02                ALL SYSTEMS                97/12/01
! PURPOSE :
!  EXTENDED LINE SEARCH WITHOUT DIRECTIONAL DERIVATIVES.
!
! PARAMETERS :
!  RO  R  VALUE OF THE STEPSIZE PARAMETER.
!  RO  RO  INITIAL VALUE OF THE STEPSIZE PARAMETER.
!  RO  RP  PREVIOUS VALUE OF THE STEPSIZE PARAMETER.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RI  FO  INITIAL VALUE OF THE OBJECTIVE FUNCTION.
!  RO  FP  PREVIOUS VALUE OF THE OBJECTIVE FUNCTION.
!  RI  PO  INITIAL VALUE OF THE DIRECTIONAL DERIVATIVE.
!  RO  PP  PREVIOUS VALUE OF THE DIRECTIONAL DERIVATIVE.
!  RI  FMIN  LOWER BOUND FOR VALUE OF THE OBJECTIVE FUNCTION.
!  RI  FMAX  UPPER BOUND FOR VALUE OF THE OBJECTIVE FUNCTION.
!  RI  RMIN  MINIMUM VALUE OF THE STEPSIZE PARAMETER
!  RI  RMAX  MAXIMUM VALUE OF THE STEPSIZE PARAMETER
!  RI  TOLS  TERMINATION TOLERANCE FOR LINE SEARCH (IN TEST ON THE
!         CHANGE OF THE FUNCTION VALUE).
!  II  KD  DEGREE OF REQUIRED DERIVATIVES.
!  IO  LD  DEGREE OF PREVIOUSLY COMPUTED DERIVATIVES OF OBJECTIVE
!  II  NIT  ACTUAL NUMBER OF ITERATIONS.
!  II  KIT  NUMBER OF THE ITERATION AFTER LAST RESTART.
!  IO  NRED  ACTUAL NUMBER OF EXTRAPOLATIONS OR INTERPOLATIONS.
!  II  MRED  MAXIMUM NUMBER OF EXTRAPOLATIONS OR INTERPOLATIONS.
!  IO  MAXST  MAXIMUM STEPSIZE INDICATOR. MAXST=0 OR MAXST=1 IF MAXIMUM
!         STEPSIZE WAS NOT OR WAS REACHED.
!  II  IEST  LOWER BOUND SPECIFICATION. IEST=0 OR IEST=1 IF LOWER BOUND
!         IS NOT OR IS GIVEN.
!  II  INITS  CHOICE OF THE INITIAL STEPSIZE. INITS=0-INITIAL STEPSIZE
!         IS SPECIFIED IN THE CALLING PROGRAM. INITS=1-UNIT INITIAL
!         STEPSIZE. INITS=2-COMBINED UNIT AND QUADRATICALLY ESTIMATED
!         INITIAL STEPSIZE. INITS=3-QUADRATICALLY ESTIMATED INITIAL
!         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.
!  II  KTERS  TERMINATION SELECTION. KTERS=1-PERFECT LINE SEARCH.
!         KTERS=2-GOLDSTEIN STEPSIZE. KTERS=3-CURRY STEPSIZE.
!         KTERS=4-EXTENDED CURRY STEPSIZE. KTERS=5-ARMIJO STEPSIZE.
!         KTERS=6-FIRST STEPSIZE.
!  II  MES  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.
!  IU  ISYS  CONTROL PARAMETER.
!
! SUBPROGRAM USED :
!  S   PNINT3  EXTRAPOLATION OR INTERPOLATION WITHOUT DIRECTIONAL
!         DERIVATIVES.
!
! METHOD :
! SAFEGUARDED EXTRAPOLATION AND INTERPOLATION WITH EXTENDED TERMINATION
! CRITERIA.
!
      SUBROUTINE PS0L02 (R, RO, RP, F, FO, FP, PO, PP, FMIN, FMAX, RMIN,
     & RMAX, TOLS, KD, LD, NIT, KIT, NRED, MRED, MAXST, IEST, INITS,
     &ITERS, KTERS, MES, ISYS)
      INTEGER KD,LD,NIT,KIT,NRED,MRED,MAXST,IEST,INITS,ITERS,KTERS,MES,
     &ISYS
      DOUBLE PRECISION R,RO,RP,F,FO,FP,PO,PP,FMIN,FMAX,RMIN,RMAX,TOLS
      DOUBLE PRECISION RL,FL,RU,FU,RI,FI,RTEMP,TOL
      INTEGER MTYP,MERR,MODE,INIT1,MES1,MES2
      LOGICAL L1,L2,L3,L4,L6,L7
      PARAMETER  (TOL=1.0D-2)
      SAVE  MTYP,MODE,MES1,MES2
      SAVE  RL,FL,RU,FU,RI,FI
      IF (ISYS.EQ.1) GO TO 20
      MES1=2
      MES2=2
      ITERS=0
      IF (PO.GE.0.0D0) THEN
        R=0.0D0
        ITERS=-2
        GO TO 30
      END IF
      IF (RMAX.LE.0.0D0) THEN
        ITERS=0
        GO TO 30
      END IF
!
!     INITIAL STEPSIZE SELECTION
!
      IF (INITS.GT.0) THEN
        RTEMP=FMIN-F
      ELSE IF (IEST.EQ.0) THEN
        RTEMP=F-FP
      ELSE
        RTEMP=MAX(F-FP,FMIN-F)
      END IF
      INIT1=ABS(INITS)
      RP=0.0D0
      FP=FO
      PP=PO
      IF (INIT1.EQ.0) THEN
      ELSE IF (INIT1.EQ.1.OR.INITS.GE.1.AND.IEST.EQ.0) THEN
        R=1.0D0
      ELSE IF (INIT1.EQ.2) THEN
        R=MIN(1.0D0,4.0D0*RTEMP/PO)
      ELSE IF (INIT1.EQ.3) THEN
        R=MIN(1.0D0,2.0D0*RTEMP/PO)
      ELSE IF (INIT1.EQ.4) THEN
        R=2.0D0*RTEMP/PO
      END IF
      RTEMP=R
      R=MAX(R,RMIN)
      R=MIN(R,RMAX)
      MODE=0
      RL=0.0D0
      FL=FO
      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
        GO TO 30
      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
      ISYS=1
      RETURN
   20 CONTINUE
      IF (ITERS.NE.0) GO TO 30
      IF (F.LE.FMIN) THEN
        ITERS=7
        GO TO 30
      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
        L4=F-FO.GE.(1.0D0-TOLS)*R*PO.OR.MES2.EQ.2.AND.MODE.EQ.2
        L6=RU-RL.LE.TOL*RU.AND.MODE.EQ.2
        L7=MES2.LE.2.OR.MODE.NE.0
        MAXST=0
        IF (L2) MAXST=1
      END IF
!
!     TEST ON TERMINATION
!
      IF (L1.AND..NOT.L3) THEN
        ITERS=0
        GO TO 30
      ELSE IF (L2.AND..NOT.F.GE.FU) THEN
        ITERS=7
        GO TO 30
      ELSE IF (L6) THEN
        ITERS=1
        GO TO 30
      ELSE IF (L3.AND.L7.AND.KTERS.EQ.5) THEN
        ITERS=5
        GO TO 30
      ELSE
     &IF (L3.AND.L4.AND.L7.AND.(KTERS.EQ.2.OR.KTERS.EQ.3.OR.KTERS.EQ.4))
     & THEN
        ITERS=2
        GO TO 30
      ELSE IF (KTERS.LT.0.OR.KTERS.EQ.6.AND.L7) THEN
        ITERS=6
        GO TO 30
      ELSE IF (ABS(NRED).GE.MRED) THEN
        ITERS=-1
        GO TO 30
      ELSE
        RP=R
        FP=F
        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
        ELSE IF (MES1.EQ.1) THEN
          MTYP=1
        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
   30 ISYS=0
      RETURN
      END
! SUBROUTINE PS1L01                ALL SYSTEMS                97/12/01
! PURPOSE :
!  STANDARD LINE SEARCH WITH DIRECTIONAL DERIVATIVES.
!
! PARAMETERS :
!  RO  R  VALUE OF THE STEPSIZE PARAMETER.
!  RO  RP  PREVIOUS VALUE OF THE STEPSIZE PARAMETER.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RI  FO  INITIAL VALUE OF THE OBJECTIVE FUNCTION.
!  RO  FP  PREVIOUS 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.
!  RI  FMIN  LOWER BOUND FOR VALUE OF THE OBJECTIVE FUNCTION.
!  RI  FMAX  UPPER BOUND FOR VALUE OF THE OBJECTIVE FUNCTION.
!  RI  RMIN  MINIMUM VALUE OF THE STEPSIZE PARAMETER
!  RI  RMAX  MAXIMUM VALUE OF THE STEPSIZE PARAMETER
!  RI  TOLS  TERMINATION TOLERANCE FOR LINE SEARCH (IN TEST ON THE
!         CHANGE OF THE FUNCTION VALUE).
!  RI  TOLP  TERMINATION TOLERANCE FOR LINE SEARCH (IN TEST ON THE
!         CHANGE OF THE DIRECTIONAL DERIVATIVE).
!  RO  PAR1  PARAMETER FOR CONTROLLED SCALING OF VARIABLE METRIC
!         UPDATES.
!  RO  PAR2  PARAMETER FOR CONTROLLED SCALING OF VARIABLE METRIC
!         UPDATES.
!  II  KD  DEGREE OF REQUIRED DERIVATIVES.
!  IO  LD  DEGREE OF PREVIOUSLY COMPUTED DERIVATIVES OF OBJECTIVE
!  II  NIT  ACTUAL NUMBER OF ITERATIONS.
!  II  KIT  NUMBER OF THE ITERATION AFTER LAST RESTART.
!  IO  NRED  ACTUAL NUMBER OF EXTRAPOLATIONS OR INTERPOLATIONS.
!  II  MRED  MAXIMUM NUMBER OF EXTRAPOLATIONS OR INTERPOLATIONS.
!  IO  MAXST  MAXIMUM STEPSIZE INDICATOR. MAXST=0 OR MAXST=1 IF MAXIMUM
!         STEPSIZE WAS NOT OR WAS REACHED.
!  II  IEST  LOWER BOUND SPECIFICATION. IEST=0 OR IEST=1 IF LOWER BOUND
!         IS NOT OR IS GIVEN.
!  II  INITS  CHOICE OF THE INITIAL STEPSIZE. INITS=0-INITIAL STEPSIZE
!         IS SPECIFIED IN THE CALLING PROGRAM. INITS=1-UNIT INITIAL
!         STEPSIZE. INITS=2-COMBINED UNIT AND QUADRATICALLY ESTIMATED
!         INITIAL STEPSIZE. INITS=3-QUADRATICALLY ESTIMATED INITIAL
!         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.
!  II  KTERS  TERMINATION SELECTION. KTERS=1-PERFECT LINE SEARCH.
!         KTERS=2-GOLDSTEIN STEPSIZE. KTERS=3-CURRY STEPSIZE.
!         KTERS=4-EXTENDED CURRY STEPSIZE. KTERS=5-ARMIJO STEPSIZE.
!         KTERS=6-FIRST STEPSIZE.
!  II  MES  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.
!  IU  ISYS  CONTROL PARAMETER.
!
! SUBPROGRAM USED :
!  S   PNINT1  EXTRAPOLATION OR INTERPOLATION WITH DIRECTIONAL
!         DERIVATIVES.
!
! METHOD :
! SAFEGUARDED EXTRAPOLATION AND INTERPOLATION WITH STANDARD TERMINATION
! CRITERIA.
!
      SUBROUTINE PS1L01 (R, RP, F, FO, FP, P, PO, PP, FMIN, FMAX, RMIN,
     &RMAX, TOLS, TOLP, PAR1, PAR2, KD, LD, NIT, KIT, NRED, MRED, MAXST,
     & IEST, INITS, ITERS, KTERS, MES, ISYS)
      INTEGER KD,LD,NIT,KIT,NRED,MRED,MAXST,IEST,INITS,ITERS,KTERS,MES,
     &ISYS
      DOUBLE PRECISION R,RP,F,FO,FP,P,PO,PP,FMIN,FMAX,RMIN,RMAX,TOLS,
     &TOLP,PAR1,PAR2
      DOUBLE PRECISION RL,FL,PL,RU,FU,PU,RTEMP
      INTEGER MTYP,MERR,MODE,INIT1,MES1,MES2,MES3
      LOGICAL L1,L2,L3,L5,L7,M1,M2,M3
      DOUBLE PRECISION CON,CON1
      PARAMETER  (CON=1.0D-2,CON1=1.0D-13)
      SAVE  MTYP,MODE,MES1,MES2,MES3
      SAVE  RL,FL,PL,RU,FU,PU
      IF (ISYS.EQ.1) GO TO 20
      MES1=2
      MES2=2
      MES3=2
      ITERS=0
      IF (PO.GE.0.0D0) THEN
        R=0.0D0
        ITERS=-2
        GO TO 30
      END IF
      IF (RMAX.LE.0.0D0) THEN
        ITERS=0
        GO TO 30
      END IF
!
!     INITIAL STEPSIZE SELECTION
!
      IF (INITS.GT.0) THEN
        RTEMP=FMIN-F
      ELSE IF (IEST.EQ.0) THEN
        RTEMP=F-FP
      ELSE
        RTEMP=MAX(F-FP,FMIN-F)
      END IF
      INIT1=ABS(INITS)
      RP=0.0D0
      FP=FO
      PP=PO
      IF (INIT1.EQ.0) THEN
      ELSE IF (INIT1.EQ.1.OR.INITS.GE.1.AND.IEST.EQ.0) THEN
        R=1.0D0
      ELSE IF (INIT1.EQ.2) THEN
        R=MIN(1.0D0,4.0D0*RTEMP/PO)
      ELSE IF (INIT1.EQ.3) THEN
        R=MIN(1.0D0,2.0D0*RTEMP/PO)
      ELSE IF (INIT1.EQ.4) THEN
        R=2.0D0*RTEMP/PO
      END IF
      R=MAX(R,RMIN)
      R=MIN(R,RMAX)
      MODE=0
      RU=0.0D0
      FU=FO
      PU=PO
!
!     NEW STEPSIZE SELECTION (EXTRAPOLATION OR INTERPOLATION)
!
   10 CALL PNINT1 (RL, RU, FL, FU, PL, PU, R, MODE, MTYP, MERR)
      IF (MERR.GT.0) THEN
        ITERS=-MERR
        GO TO 30
      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 AND THE NEW DIRECTIONAL
!     DERIVATIVE
!
      KD=1
      LD=-1
      ISYS=1
      RETURN
   20 CONTINUE
      IF (MODE.EQ.0) THEN
        PAR1=P/PO
        PAR2=F-FO
      END IF
      IF (ITERS.NE.0) GO TO 30
      IF (F.LE.FMIN) THEN
        ITERS=7
        GO TO 30
      ELSE
        L1=R.LE.RMIN.AND.NIT.NE.KIT
        L2=R.GE.RMAX
        L3=F-FO.LE.TOLS*R*PO
        L5=P.GE.TOLP*PO.OR.MES2.EQ.2.AND.MODE.EQ.2
        L7=MES2.LE.2.OR.MODE.NE.0
        M1=.FALSE.
        M2=.FALSE.
        M3=L3
        IF (MES3.GE.1) THEN
          M1=ABS(P).LE.CON*ABS(PO).AND.FO-F.GE.(CON1/CON)*ABS(FO)
          L3=L3.OR.M1
        END IF
        IF (MES3.GE.2) THEN
          M2=ABS(P).LE.0.5D0*ABS(PO).AND.ABS(FO-F).LE.2.0D0*CON1*ABS(FO)
          L3=L3.OR.M2
        END IF
        MAXST=0
        IF (L2) MAXST=1
      END IF
!
!     TEST ON TERMINATION
!
      IF (L1.AND..NOT.L3) THEN
        ITERS=0
        GO TO 30
      ELSE IF (L2.AND.L3.AND..NOT.L5) THEN
        ITERS=7
        GO TO 30
      ELSE IF (M3.AND.MES1.EQ.3) THEN
        ITERS=5
        GO TO 30
      ELSE IF (L3.AND.L5.AND.L7) THEN
        ITERS=4
        GO TO 30
      ELSE IF (KTERS.LT.0.OR.KTERS.EQ.6.AND.L7) THEN
        ITERS=6
        GO TO 30
      ELSE IF (ABS(NRED).GE.MRED) THEN
        ITERS=-1
        GO TO 30
      ELSE
        RP=R
        FP=F
        PP=P
        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=RU
        FL=FU
        PL=PU
        RU=R
        FU=F
        PU=P
        IF (.NOT.L3) THEN
          NRED=0
          MODE=2
        ELSE IF (MES1.EQ.1) THEN
          MTYP=1
        END IF
      ELSE
!
!     INTERVAL CHANGE AFTER INTERPOLATION
!
        IF (.NOT.L3) THEN
          RU=R
          FU=F
          PU=P
        ELSE
          RL=R
          FL=F
          PL=P
        END IF
      END IF
      GO TO 10
   30 ISYS=0
      RETURN
      END
! SUBROUTINE PS1L18                ALL SYSTEMS                99/12/01
! 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  KD  DEGREE OF REQUIRED DERIVATIVES.
!  IO  LD  DEGREE OF PREVIOUSLY COMPUTED DERIVATIVES OF OBJECTIVE
!  II  JE  EXTRAPOLATION INDICATOR.
!  RI  MOS3   LOCALITY MEASURE PARAMETER.
!  IO  ITERS  NULL STEP INDICATOR. ITERS=0-NULL STEP. ITERS=1-DESCENT
!         STEP.
!  IU  ISYS  CONTROL PARAMETER.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
!  IO  NIN  NUMBER OF INNER ITERATIONS.
!  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   PNINT1  EXTRAPOLATION OR INTERPOLATION FOR LINE SEARCH
!  S   PNSTP4  STEPSIZE DETERMINATION FOR DESCENT STEPS.
!  S   PNSTP5  STEPSIZE DETERMINATION FOR NULL STEPS.
!              WITH DIRECTIONAL DERIVATIVES.
!  S   MXVDIR  VECTOR AUGMENTED BY THE SCALED VECTOR.
!  RF  MXVDOT  DOT PRODUCT OF TWO VECTORS.
!
! METHOD :
! SPECIAL METHOD OF STEP LENGTH DETERMINATION.
!
      SUBROUTINE PS1L18 (N, MA, MAL, X, G, S, U, AF, AG, AY, T, TB, FO,
     &F, PO, P, TMIN, TMAX, SNORM, WK, EPS1, EPS2, ETA5, ETA9, KD, LD,
     &JE, MOS3, ITERS, ISYS)
      DOUBLE PRECISION EPS1,EPS2,ETA5,ETA9,F,FO,P,PO,SNORM,T,TB,TMAX,
     &TMIN,WK
      INTEGER ITERS,ISYS,JE,KD,LD,MA,MAL,MOS3,N
      DOUBLE PRECISION AF(*),AG(*),AY(*),G(*),S(*),U(*),X(*)
      DOUBLE PRECISION BET,FL,FU,PL,PU,TL,TU
      INTEGER IER
      DOUBLE PRECISION MXVDOT
      SAVE  FL,FU,PL,PU,TL,TU
      IF (ISYS.GT.0) GO TO 30
      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)
      KD=1
      LD=-1
      ISYS=1
      RETURN
   30 CONTINUE
      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 50
      IF (P-BET.GE.-EPS2*WK.OR.TU-TL.LT.TMIN*1.0D-1) GO TO 40
      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
   40 ITERS=0
   50 CONTINUE
      ISYS=0
      RETURN
      END
! SUBROUTINE PUBBM1                ALL SYSTEMS                97/12/01
! PURPOSE :
! PARTITIONED VARIABLE METRIC UPDATE.
!
! PARAMETERS :
!  II  NA  NUMBER OF BLOCKS OF THE MATRIX H.
!  RU  AH(MB)  APPROXIMATION OF THE PARTITIONED HESSIAN MATRIX.
!  RI  IAG(NA+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
!  RI  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
!  RA  S(NF)  AUXILIARY VECTOR.
!  RU  XO(NF)  VECTORS OF VARIABLES DIFFERENCE.
!  RI  AGO(MA)  GRADIENTS DIFFERENCE.
!  RI  ETA0  MACHINE PRECISION.
!  RI  ETA9  MAXIMUM MACHINE NUMBER.
!  IU  ICOR  SWITCH BETWEEN UPDATES. ICOR=0-THE BFGS UPDATE.
!         ICOR=1-THE RANK ONE UPDATE.
!  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  METHOD SELECTION. MET=0-NO UPDATE. MET=1-BFGS UPDATE.
!         MET=2-COMBINATION OF BFGS AND RANK-ONE UPDATES.
!  II  MET1  SELECTION OF SELF SCALING.  MET1=1-SELF SCALING SUPPRESSED.
!         MET1=2 SELF SCALING IN THE FIRST ITERATION AFTER RESTART.
!         MET1=3-SELF SCALING IN EACH ITERATION.
!
! SUBPROGRAMS USED :
!  S   MXBSBM  MULTIPLICATION OF A PARTITIONED MATRIX BY A VECTOR.
!  S   MXBSBU  UPDATE OF A PARTITIONED MATRIX.
!  S   MXDSMS  SCALING OF A DENSE SYMMETRIC MATRIX.
!  S   MXWDIR  VECTOR AUGMENTED BY THE SCALED VECTOR.
!  RF  MXWDOT  DOT PRODUCT OF TWO SPARSE VECTORS.
!
      SUBROUTINE PUBBM1 (NA, AH, IAG, JAG, S, XO, AGO, ETA0, ETA9, ICOR,
     & NIT, KIT, ITERH, MET, MET1)
      INTEGER NA,IAG(*),JAG(*),ICOR,NIT,KIT,ITERH,MET,MET1
      DOUBLE PRECISION AH(*),S(*),XO(*),AGO(*),ETA0,ETA9
      DOUBLE PRECISION A,B,C,GAM,POM,DEN,MXWDOT
      INTEGER K,L,KA,NB,INEG
      LOGICAL L1,L3
      IF (MET.LE.0) GO TO 30
      L1=MET1.GE.3.OR.MET1.EQ.2.AND.NIT.EQ.KIT
      L3=.NOT.L1
      NB=0
      INEG=0
      DO 20 KA=1,NA
        K=IAG(KA)
        L=IAG(KA+1)-K
!
!     DETERMINATION OF THE PARAMETERS B, C
!
        B=MXWDOT(L,JAG(K),AGO(K),XO,2)
        IF (MET.EQ.1) THEN
          IF (B.LE.1.0D0/ETA9) GO TO 10
        ELSE
          IF (ABS(B).LE.1.0D0/ETA9) GO TO 10
        END IF
        A=0.0D0
        CALL MXBSBM (L, AH(NB+1), JAG(K), XO, S, 1)
        C=MXWDOT(L,JAG(K),XO,S,1)
        IF (ABS(C).LE.1.0D0/ETA9) GO TO 10
        IF (L1) THEN
!
!     DETERMINATION OF THE PARAMETER GAM (SELF SCALING)
!
          GAM=C/B
          IF (L3) THEN
            GAM=1.0D0
          END IF
        ELSE
          GAM=1.0D0
        END IF
        IF (MET.EQ.1) THEN
!
!     BFGS UPDATE
!
          POM=0.0D0
          CALL MXBSBU (L, AH(NB+1), JAG(K), GAM/B, AGO(K), 2)
          CALL MXBSBU (L, AH(NB+1), JAG(K), -1.0D0/C, S, 1)
        ELSE
          IF (B.LT.0.0D0) INEG=INEG+1
          IF (ICOR.GT.0) THEN
!
!    RANK ONE UPDATE
!
            DEN=GAM*B-C
            IF (ABS(DEN).GT.ETA0*ABS(C)) THEN
              POM=GAM*B/DEN
              CALL MXWDIR (L, JAG(K), -GAM, AGO(K), S, AGO(K), 2)
              CALL MXBSBU (L, AH(NB+1), JAG(K), 1.0D0/DEN, AGO(K), 2)
            ELSE
              GO TO 10
            END IF
          ELSE IF (B.LT.0.0D0) THEN
            GO TO 10
          ELSE
!
!     BFGS UPDATE
!
            POM=0.0D0
            CALL MXBSBU (L, AH(NB+1), JAG(K), GAM/B, AGO(K), 2)
            CALL MXBSBU (L, AH(NB+1), JAG(K), -1.0D0/C, S, 1)
          END IF
        END IF
        ITERH=0
        IF (GAM.NE.1.0D0) THEN
          CALL MXDSMS (L, AH(NB+1), 1.0D0/GAM)
        END IF
   10   CONTINUE
        NB=NB+L*(L+1)/2
   20 CONTINUE
      IF (INEG.GE.NA/2) ICOR=1
   30 CONTINUE
      RETURN
      END
! SUBROUTINE PUBBM2                ALL SYSTEMS                97/12/01
! PURPOSE :
! PARTITIONED VARIABLE METRIC UPDATE.
!
! PARAMETERS :
!  II  NA  NUMBER OF BLOCKS OF THE MATRIX H.
!  RU  AH(MB)  APPROXIMATION OF THE PARTITIONED HESSIAN MATRIX.
!  RI  IAG(NA+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
!  RI  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
!  RA  S(NF)  AUXILIARY VECTOR.
!  RU  XO(NF)  VECTORS OF VARIABLES DIFFERENCE.
!  RI  AGO(MA)  GRADIENTS DIFFERENCE.
!  RI  ETA0  MACHINE PRECISION.
!  RI  ETA9  MAXIMUM MACHINE NUMBER.
!  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  VARIABLE METRIC UPDATE. MET=1-THE BFGS UPDATE. MET=2-THE
!         DFP UPDATE. MET=3-THE HOSHINO UPDATE. MET=4-THE RANK ONE
!         UPDATE.
!  II  MET1  SELECTION OF SELF SCALING. MET1=1-SELF SCALING SUPPRESSED.
!         MET1=2 SELF SCALING IN THE FIRST ITERATION AFTER RESTART.
!         MET1=3-CONTROLLED SELF SCALING.
!  II  MET3  CORRECTION OF THE UPDATE. MET3=1-CORRECTION IS SUPPRESSED.
!         MET3=2-THE POWELL UPDATE.
!
! SUBPROGRAMS USED :
!  S   MXBSBM  MULTIPLICATION OF A PARTITIONED MATRIX BY A VECTOR.
!  S   MXBSBU  UPDATE OF A PARTITIONED MATRIX.
!  S   MXDSMS  SCALING OF A DENSE SYMMETRIC MATRIX.
!  S   MXWDIR  VECTOR AUGMENTED BY THE SCALED VECTOR.
!  RF  MXWDOT  DOT PRODUCT OF TWO SPARSE VECTORS.
!
      SUBROUTINE PUBBM2 (NA, AH, IAG, JAG, S, XO, AGO, ETA0, ETA9, NIT,
     &KIT, ITERH, MET, MET1, MET3)
      INTEGER NA,IAG(*),JAG(*),NIT,KIT,ITERH,MET,MET1,MET3
      DOUBLE PRECISION AH(*),S(*),XO(*),AGO(*),ETA0,ETA9
      DOUBLE PRECISION A,B,C,GAM,POM,DEN,DIS,MXWDOT
      INTEGER K,L,KA,NB
      LOGICAL L1,L3
      DOUBLE PRECISION CON,CON1,CON2
      PARAMETER  (CON=0.1D0,CON1=0.5D0,CON2=4.0D0)
      L1=MET1.GE.3.OR.MET1.EQ.2.AND.NIT.EQ.KIT
      L3=.NOT.L1
      NB=0
      DO 40 KA=1,NA
        K=IAG(KA)
        L=IAG(KA+1)-K
!
!     DETERMINATION OF THE PARAMETERS B, C
!
        B=MXWDOT(L,JAG(K),AGO(K),XO,2)
        IF (MET3.EQ.1) THEN
          IF (B.LE.1.0D0/ETA9) GO TO 30
        ELSE
          IF (ABS(B).LE.1.0D0/ETA9) GO TO 30
        END IF
        A=0.0D0
        CALL MXBSBM (L, AH(NB+1), JAG(K), XO, S, 1)
        C=MXWDOT(L,JAG(K),XO,S,1)
        IF (MET3.EQ.3) THEN
          IF (ABS(C).LE.1.0D0/ETA9) GO TO 30
        ELSE
          IF (C.LE.1.0D0/ETA9) GO TO 30
        END IF
        IF (MET3.EQ.2) THEN
          IF (B.LE.0.0D0) THEN
!
!     POWELL'S CORRECTION
!
            DIS=(1.0D0-CON)*C/(C-B)
            CALL MXWDIR (L, JAG(K), -1.0D0, AGO(K), S, AGO(K), 2)
            CALL MXWDIR (L, JAG(K), -DIS, AGO(K), S, AGO(K), 2)
            B=C+DIS*(B-C)
          END IF
        END IF
        IF (L1) THEN
!
!     DETERMINATION OF THE PARAMETER GAM (SELF SCALING)
!
          GAM=C/B
          IF (MET1.EQ.3) THEN
            IF (NIT.NE.KIT) THEN
              L3=GAM.LT.CON1.OR.GAM.GT.CON2
            END IF
          ELSE IF (MET1.EQ.4) THEN
            GAM=MAX(1.0D0,GAM)
          END IF
          IF (L3) THEN
            GAM=1.0D0
          END IF
        ELSE
          GAM=1.0D0
        END IF
        IF (MET.EQ.1) THEN
          GO TO 10
        ELSE IF (MET.EQ.2) THEN
!
!     DFP UPDATE
!
          DEN=GAM*B+C
          DIS=GAM+C/B
          POM=1.0D0
          CALL MXWDIR (L, JAG(K), -DIS, AGO(K), S, AGO(K), 2)
          CALL MXBSBU (L, AH(NB+1), JAG(K), 1.0D0/DEN, AGO(K), 2)
          CALL MXBSBU (L, AH(NB+1), JAG(K), -1.0D0/DEN, S, 1)
          GO TO 20
        ELSE IF (MET.EQ.3) THEN
!
!     HOSHINO UPDATE
!
          DEN=GAM*B+C
          DIS=0.5D0*B
          POM=GAM*B/DEN
          CALL MXBSBU (L, AH(NB+1), JAG(K), GAM/DIS, AGO(K), 2)
          CALL MXWDIR (L, JAG(K), GAM, AGO(K), S, AGO(K), 2)
          CALL MXBSBU (L, AH(NB+1), JAG(K), -1.0D0/DEN, AGO(K), 2)
          GO TO 20
        ELSE IF (MET.EQ.4) THEN
!
!     RANK ONE UPDATE
!
          DEN=GAM*B-C
          IF (MET3.EQ.3) THEN
            IF (ABS(DEN).LE.ETA0*ABS(C)) GO TO 10
          ELSE
            IF (DEN.LE.ETA0*C) GO TO 10
          END IF
          POM=GAM*B/DEN
          CALL MXWDIR (L, JAG(K), -GAM, AGO(K), S, AGO(K), 2)
          CALL MXBSBU (L, AH(NB+1), JAG(K), 1.0D0/DEN, AGO(K), 2)
          GO TO 20
        END IF
   10   CONTINUE
!
!     BFGS UPDATE
!
        POM=0.0D0
        CALL MXBSBU (L, AH(NB+1), JAG(K), GAM/B, AGO(K), 2)
        CALL MXBSBU (L, AH(NB+1), JAG(K), -1.0D0/C, S, 1)
   20   CONTINUE
        ITERH=0
        IF (GAM.NE.1.0D0) THEN
          CALL MXDSMS (L, AH(NB+1), 1.0D0/GAM)
        END IF
   30   CONTINUE
        NB=NB+L*(L+1)/2
   40 CONTINUE
      RETURN
      END
! SUBROUTINE PUBVI2                ALL SYSTEMS                04/12/01
! PURPOSE :
! NONSMOOTH VARIABLE METRIC UPDATE OF THE INVERSE HESSIAN MATRIX.
!
! PARAMETERS :
!  II  NF  ACTUAL NUMBER OF VARIABLES.
!  II  NA  NUMBER OF APPROXIMATED FUNCTIONS.
!  II  MA  NUMBER OF ELEMENTS IN THE FIELD AG.
!  II  MB  NUMBER OF NONZERO ELEMENTS OF THE PARTITIONED HESSIAN MATRIX.
!  RU  AH(MB)  NUMERICAL VALUES OF ELEMENTS OF THE PARTITIONED HESSIAN
!         MATRIX.
!  II  IAG(NA+1)  POINTERS OF THE JACOBIAN MATRIX.
!  RI  JAG(MA)  COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
!  RI  AG(NF)  NEW GENERALIZED JACOBIAN MATRIX.
!  RI  AGO(NF)  OLD GENERALIZED JACOBIAN MATRIX.
!  RI  XO(N)  VECTOR OF VARIABLES DIFFERENCE.
!  RO  S(NF)  AUXILIARY VECTOR.
!  RO  U(NF)  AUXILIARY VECTOR.
!  RI  ETA9  MAXIMUM MACHINE NUMBER.
!  II  NNK  CONSECUTIVE NULL STEPS COUNTER.
!  II  NIT  ACTUAL NUMBER OF ITERATIONS.
!  IO  ITERH  TERMINATION INDICATOR. ITERH<0-BAD DECOMPOSITION.
!         ITERH=0-SUCCESSFUL UPDATE. ITERH>0-NONPOSITIVE PARAMETERS.
!
! SUBPROGRAMS USED :
!  S   MXBSBM  MULTIPLICATION OF A DENSE SYMMETRIC MATRIX BY A VECTOR.
!  S   MXBSBU  UPDATE OF A PARTITIONED SYMMETRIC MATRIX.
!  S   MXDSMS  SCALING OF A DENSE SYMMETRIC MATRIX.
!  S   MXVDIF  DIFFERENCE OF TWO VECTORS.
!  S   MXWDIR  VECTOR AUGMENTED BY THE SCALED VECTOR.
!  RF  MXWDOT  DOT PRODUCT OF VECTORS.
!
      SUBROUTINE PUBVI2 (NA, AH, IAG, JAG, AG, AGO, XO, S, U, ETA9, NNK,
     & NIT, ITERH)
      INTEGER NA,IAG(*),JAG(*),NNK,NIT,ITERH
      DOUBLE PRECISION AH(*),AG(*),AGO(*),XO(*),S(*),U(*),ETA9
      DOUBLE PRECISION GAM,A,B,C,Q,DEN,POM,MXWDOT
      INTEGER KA,K,L,NB,INEG
      LOGICAL LB,LR
      NB=0
      INEG=0
      DO 20 KA=1,NA
        K=IAG(KA)
        L=IAG(KA+1)-K
        CALL MXVDIF (L, AG(K), AGO(K), U)
!
!     DETERMINATION OF THE PARAMETERS B, C
!
        B=MXWDOT(L,JAG(K),U,XO,2)
        IF (ABS(B).LE.1.0D0/ETA9) GO TO 10
        A=0.0D0
        CALL MXBSBM (L, AH(NB+1), JAG(K), XO, S, 1)
        C=MXWDOT(L,JAG(K),XO,S,1)
        IF (ABS(C).LE.1.0D0/ETA9) GO TO 10
        GAM=1.0D0
        IF (NIT.EQ.1) THEN
          Q=1.0D0
          IF (C.NE.0.0D0) Q=C/B
          IF ((Q-2.5D-1)*(Q-3.0D0).GT.0.0D0) GAM=MIN(3.0D0,MAX(2.0D-2,Q)
     &     )
        END IF
        IF (B.LT.0.0D0) INEG=INEG+1
        LB=NNK.EQ.0
        LR=NNK.NE.0.AND.C.LT.GAM*B
        IF (NIT.EQ.1) LR=LR.AND.GAM.NE.Q
        IF (LB) THEN
          IF (B.LT.0.0D0) GO TO 10
!
!     BFGS UPDATE
!
          POM=0.0D0
          CALL MXBSBU (L, AH(NB+1), JAG(K), GAM/B, U, 2)
          CALL MXBSBU (L, AH(NB+1), JAG(K), -1.0D0/C, S, 1)
          ITERH=0
          IF (GAM.NE.1.0D0) THEN
            CALL MXDSMS (L, AH(NB+1), 1.0D0/GAM)
          END IF
        ELSE IF (LR) THEN
          DEN=GAM*B-C
          POM=GAM*B/DEN
          CALL MXWDIR (L, JAG(K), -GAM, U, S, U, 2)
          CALL MXBSBU (L, AH(NB+1), JAG(K), 1.0D0/DEN, U, 2)
        END IF
   10   CONTINUE
        NB=NB+L*(L+1)/2
   20 CONTINUE
      RETURN
      END
! SUBROUTINE PULCI3                ALL SYSTEMS                96/12/01
! PURPOSE :
! LIMITED STORAGE INVERSE COLUMN UPDATE METHODS.
!
! PARAMETERS :
!  II  N NUMBER OF VARIABLES.
!  RI  A(IAG(N+1)-1)  SPARSE RECTANGULAR MATRIX WHICH IS USED FOR THE
!         DIRECTION VECTOR DETERMINATION.
!  II  IA(N+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD AG.
!  II  JA(MA) COLUMN INDICES OF ELEMENTS IN THE FIELD AG.
!  IU  IP(N)  PERMUTATION VECTOR.
!  IU  ID(N)  POSITION OF THE DIAGONAL ELEMENTS IN THE FIELD AG.
!  RU  XM(N*MF)  SET OF VECTORS FOR INVERSE COLUMN UPDATE.
!  RU  GM(MF)  SET OF VALUES FOR INVERSE COLUMN UPDATE.
!  IU  IM(MF)  SET OF INDICES FOR INVERSE COLUMN UPDATE.
!  RA  XO(N)  AUXILIARY VECTOR.
!  RI  AFO(N)  GRADIENTS DIFERENCES.
!  RO  S(N)  DIRECTION VECTOR.
!  II  MF  NUMBER OF VARIABLE METRIC UPDATES.
!  II  NIT  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.
!  IU  IREST  RESTART INDICATOR.
!
! SUBPROGRAMS USED :
!  S   MXLIIM  MATRIX MULTIPLICATION FOR LIMITED STORAGE INVERSE
!  S   MXVDIR  VECTOR AUGMENTED BY THE SCALED VECTOR.
!  RF  MXVMX1  DOT PRODUCT OF VECTORS.
!
! METHOD :
! LIMITED STORAGE VARIABLE METRIC METHODS.
!
      SUBROUTINE PULCI3 (N, A, IA, JA, IP, ID, XM, GM, IM, XO, AFO, S,
     &MF, NIT, KIT, ITERH, IREST)
      INTEGER IREST,ITERH,NIT,KIT,MF,N
      DOUBLE PRECISION A(*),AFO(*),GM(*),S(*),XM(*),XO(*)
      INTEGER IA(*),ID(*),IM(*),IP(*),JA(*)
      DOUBLE PRECISION TEMP
      INTEGER II,MA,MM
      DOUBLE PRECISION MXVMX1
      MA=IA(N+1)-1
      MM=MIN(NIT-KIT,MF)
      IF (MM.GE.MF) THEN
        ITERH=1
        IREST=1
      ELSE
        II=N*MM+1
        CALL MXLIIM (N, MM, A(MA+1), IA, JA, IP, ID, XM, GM, IM, AFO,
     &   XM(II), S)
        CALL MXVDIR (N, -1.0D0, XM(II), XO, XM(II))
        MM=MM+1
        TEMP=MXVMX1(N,AFO,II)
        IF (TEMP.LE.0.0D0) THEN
          ITERH=2
        ELSE
          IM(MM)=II
          GM(MM)=AFO(II)
          ITERH=0
        END IF
      END IF
      RETURN
      END
! SUBROUTINE PULSP3                ALL SYSTEMS                02/12/01
! PURPOSE :
! LIMITED STORAGE VARIABLE METRIC UPDATE.
!
! PARAMETERS :
!  II  N  NUMBER OF VARIABLES (NUMBER OF ROWS OF XM).
!  II  M  NUMBER OF COLUMNS OF XM.
!  II  MF  MAXIMUM NUMBER OF COLUMNS OF XM.
!  RI  XM(N*M)  RECTANGULAR MATRIX IN THE PRODUCT FORM SHIFTED BROYDEN
!         METHOD (STORED COLUMNWISE): H-SIGMA*I=XM*TRANS(XM)
!  RO  GR(M)  MATRIX TRANS(XM)*GO.
!  RU  XO(N)  VECTORS OF VARIABLES DIFFERENCE XO AND VECTOR XO-TILDE.
!  RU  GO(N)  GRADIENT DIFFERENCE GO AND VECTOR XM*TRANS(XM)*GO.
!  RI  R  STEPSIZE PARAMETER.
!  RI  PO  OLD DIRECTIONAL DERIVATIVE (MULTIPLIED BY R)
!  RU  SIG  SCALING PARAMETER (ZETA AND SIGMA).
!  IO  ITERH  TERMINATION INDICATOR. ITERH<0-BAD DECOMPOSITION.
!         ITERH=0-SUCCESSFUL UPDATE. ITERH>0-NONPOSITIVE PARAMETERS.
!  II  MET3  CHOICE OF SIGMA (1-CONSTANT, 2-QUADRATIC EQUATION).
!
! SUBPROGRAMS USED :
!  S   MXDRMM  MULTIPLICATION OF A ROWWISE STORED DENSE RECTANGULAR
!         MATRIX BY A VECTOR.
!  S   MXDCMU  UPDATE OF A COLUMNWISE STORED DENSE RECTANGULAR MATRIX.
!         WITH CONTROLLING OF POSITIVE DEFINITENESS.
!  S   MXVDIR  VECTOR AUGMENTED BY A SCALED VECTOR.
!  RF  MXVDOT  DOT PRODUCT OF VECTORS.
!  S   MXVSCL  SCALING OF A VECTOR.
!
! METHOD :
! SHIFTED BFGS METHOD IN THE PRODUCT FORM.
!
      SUBROUTINE PULSP3 (N, M, MF, XM, GR, XO, GO, R, PO, SIG, ITERH,
     &MET3)
      INTEGER N,M,MF,ITERH,MET3
      DOUBLE PRECISION XM(*),GR(*),XO(*),GO(*),R,PO,SIG
      DOUBLE PRECISION DEN,POM,A,B,C,AA,AH,BB,PAR,MXVDOT
      IF (M.GE.MF) RETURN
      B=MXVDOT(N,XO,GO)
      IF (B.LE.0.0D0) THEN
        ITERH=2
        GO TO 10
      END IF
      CALL MXDRMM (N, M, XM, GO, GR)
      AH=MXVDOT(N,GO,GO)
      AA=MXVDOT(M,GR,GR)
      A=AA+AH*SIG
      C=-R*PO
!
!     DETERMINATION OF THE PARAMETER SIG (SHIFT)
!
      PAR=1.0D0
      POM=B/AH
      IF (A.GT.0.0D0) THEN
        DEN=MXVDOT(N,XO,XO)
        IF (MET3.LE.4) THEN
          SIG=SQRT(MAX(0.0D0,1.0D0-AA/A))/(1.0D0+SQRT(MAX(0.0D0,1.0D0-B*
     &     B/(DEN*AH))))*POM
        ELSE
          SIG=SQRT(MAX(0.0D0,SIG*AH/A))/(1.0D0+SQRT(MAX(0.0D0,1.0D0-B*B/
     &     (DEN*AH))))*POM
        END IF
        SIG=MAX(SIG,2.0D-1*POM)
        SIG=MIN(SIG,8.0D-1*POM)
      ELSE
        SIG=2.5D-1*POM
      END IF
!
!     COMPUTATION OF SHIFTED XO AND SHIFTED B
!
      BB=B-AH*SIG
      CALL MXVDIR (N, -SIG, GO, XO, XO)
!
!     BFGS-BASED SHIFTED BFGS UPDATE
!
      POM=1.0D0
      CALL MXDCMU (N, M, XM, -1.0D0/BB, XO, GR)
      CALL MXVSCL (N, SQRT(PAR/BB), XO, XM(N*M+1))
      M=M+1
   10 CONTINUE
      ITERH=0
      RETURN
      END
! SUBROUTINE PULVP3                ALL SYSTEMS                03/12/01
! PURPOSE :
! RANK-TWO LIMITED-STORAGE VARIABLE-METRIC METHODS IN THE PRODUCT FORM.
!
! PARAMETERS :
!  II  N  NUMBER OF VARIABLES (NUMBER OF ROWS OF XM).
!  II  M  NUMBER OF COLUMNS OF XM.
!  RI  XM(N*M)  RECTANGULAR MATRIX IN THE PRODUCT FORM SHIFTED BROYDEN
!         METHOD (STORED COLUMNWISE): H-SIGMA*I=XM*TRANS(XM)
!  RO  XR(M)  VECTOR TRANS(XM)*H**(-1)*XO.
!  RO  GR(M)  MATRIX TRANS(XM)*GO.
!  RA  S(N)  AUXILIARY VECTORS (H**(-1)*XO AND U).
!  RA  SO(N)  AUXILIARY VECTORS ((H-SIGMA*I)*H**(-1)*XO AND V).
!  RU  XO(N)  VECTORS OF VARIABLES DIFFERENCE XO AND VECTOR XO-TILDE.
!  RU  GO(N)  GRADIENT DIFFERENCE GO AND VECTOR XM*TRANS(XM)*GO.
!  RI  R  STEPSIZE PARAMETER.
!  RI  PO  OLD DIRECTIONAL DERIVATIVE (MULTIPLIED BY R)
!  RU  SIG  SCALING PARAMETER (ZETA AND SIGMA).
!  IO  ITERH  TERMINATION INDICATOR. ITERH<0-BAD DECOMPOSITION.
!         ITERH=0-SUCCESSFUL UPDATE. ITERH>0-NONPOSITIVE PARAMETERS.
!  II  MET2  CHOICE OF THE CORRECTION PARAMETER (1-THE UNIT VALUE,
!         2-THE BALANCING VALUE, 3-THE SQUARE ROOT, 4-THE GEOMETRIC
!         MEAN).
!  II  MET3  CHOICE OF THE SHIFT PARAMETER (4-THE FIRST FORMULA,
!         5-THE SECOND FORMULA).
!  II  MET5  CHOICE OF THE METHOD (1-RANK-ONE METHOD, 2-RANK-TWO
!         METHOD).
!
! SUBPROGRAMS USED :
!  S   MXDRMM  MULTIPLICATION OF A ROWWISE STORED DENSE RECTANGULAR
!         MATRIX BY A VECTOR.
!  S   MXDCMU  UPDATE OF A COLUMNWISE STORED DENSE RECTANGULAR MATRIX.
!         WITH CONTROLLING OF POSITIVE DEFINITENESS. RANK-ONE FORMULA.
!  S   MXDCMV  UPDATE OF A COLUMNWISE STORED DENSE RECTANGULAR MATRIX.
!         WITH CONTROLLING OF POSITIVE DEFINITENESS. RANK-TWO FORMULA.
!  S   MXVDIR  VECTOR AUGMENTED BY A SCALED VECTOR.
!  RF  MXVDOT  DOT PRODUCT OF VECTORS.
!  S   MXVLIN  LINEAR COMBINATION OF TWO VECTORS.
!  S   MXVSCL  SCALING OF A VECTOR.
!
! METHOD :
! RANK-ONE LIMITED-STORAGE VARIABLE-METRIC METHOD IN THE PRODUCT FORM.
!
      SUBROUTINE PULVP3 (N, M, XM, XR, GR, S, SO, XO, GO, R, PO, SIG,
     &ITERH, MET2, MET3, MET5)
      INTEGER N,M,ITERH,MET2,MET3,MET5
      DOUBLE PRECISION XM(*),XR(*),GR(*),S(*),SO(*),XO(*),GO(*),R,PO,
     &SIG
      DOUBLE PRECISION MXVDOT
      DOUBLE PRECISION DEN,POM,A,B,C,AA,BB,CC,AH,PAR,ZET
      ZET=SIG
!
!     COMPUTATION OF B
!
      B=MXVDOT(N,XO,GO)
      IF (B.LE.0.0D0) THEN
        ITERH=2
        GO TO 10
      END IF
!
!     COMPUTATION OF GR=TRANS(XM)*GO, XR=TRANS(XM)*H**(-1)*XO
!     AND S=H**(-1)*XO, SO=(H-SIGMA*I)*H**(-1)*XO. COMPUTATION
!     OF AA=GR*GR, BB=GR*XR, CC=XR*XR. COMPUTATION OF A AND C.
!
      CALL MXDRMM (N, M, XM, GO, GR)
      CALL MXVSCL (N, R, S, S)
      CALL MXDRMM (N, M, XM, S, XR)
      CALL MXVDIR (N, -SIG, S, XO, SO)
      AH=MXVDOT(N,GO,GO)
      AA=MXVDOT(M,GR,GR)
      BB=MXVDOT(M,GR,XR)
      CC=MXVDOT(M,XR,XR)
      A=AA+AH*SIG
      C=-R*PO
!
!     DETERMINATION OF THE PARAMETER SIG (SHIFT)
!
      POM=B/AH
      IF (A.GT.0.0D0) THEN
        DEN=MXVDOT(N,XO,XO)
        IF (MET3.LE.4) THEN
          SIG=SQRT(MAX(0.0D0,1.0D0-AA/A))/(1.0D0+SQRT(MAX(0.0D0,1.0D0-B*
     &     B/(DEN*AH))))*POM
        ELSE
          SIG=SQRT(MAX(0.0D0,SIG*AH/A))/(1.0D0+SQRT(MAX(0.0D0,1.0D0-B*B/
     &     (DEN*AH))))*POM
        END IF
        SIG=MAX(SIG,2.0D-1*POM)
        SIG=MIN(SIG,8.0D-1*POM)
      ELSE
        SIG=2.5D-1*POM
      END IF
!
!     COMPUTATION OF SHIFTED XO AND SHIFTED B
!
      B=B-AH*SIG
      CALL MXVDIR (N, -SIG, GO, XO, XO)
!
!     COMPUTATION OF THE PARAMETER RHO (CORRECTION)
!
      IF (MET2.LE.1) THEN
        PAR=1.0D0
      ELSE IF (MET2.EQ.2) THEN
        PAR=SIG*AH/B
      ELSE IF (MET2.EQ.3) THEN
        PAR=SQRT(1.0D0-AA/A)
      ELSE IF (MET2.EQ.4) THEN
        PAR=SQRT(SQRT(1.0D0-AA/A)*(SIG*AH/B))
      ELSE
        PAR=ZET/(ZET+SIG)
      END IF
!
!     COMPUTATION OF THE PARAMETER THETA (BFGS)
!
      POM=SIGN(SQRT(PAR*B/CC),BB)
!
!     COMPUTATION OF Q AND P
!
      IF (MET5.EQ.1) THEN
!
!     RANK ONE UPDATE OF XM
!
        CALL MXVDIR (M, POM, XR, GR, XR)
        CALL MXVLIN (N, PAR, XO, POM, SO, S)
        CALL MXDCMU (N, M, XM, -1.0D0/(PAR*B+POM*BB), S, XR)
      ELSE
!
!     RANK TWO UPDATE OF XM
!
        CALL MXVDIR (N, PAR/POM-BB/B, XO, SO, S)
        CALL MXDCMV (N, M, XM, -1.0D0/B, XO, GR, -1.0D0/CC, S, XR)
      END IF
   10 CONTINUE
      ITERH=0
      RETURN
      END
! SUBROUTINE PUSMM1                ALL SYSTEMS                97/12/01
! PURPOSE :
! VARIABLE METRIC UPDATE OF A SPARSE SYMMETRIC POSITIVE DEFINITE MATRIX
! USING THE MARWIL PROJECTION.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  RU  H(M)  POSITIVE DEFINITE APPROXIMATION OF THE SPARSE HESSIAN
!         MATRIX.
!  II  IH(NF)  POINTERS OF THE DIAGONAL ELEMENTS OF H.
!  II  JH(M)  INDICES OF THE NONZERO ELEMENTS OF H.
!  RI  G(NF)  GRADIENT OF THE OBJECTIVE FUNCTION.
!  RA  XS(NF)  AUXILIARY VECTOR.
!  RA  S(NF)  AUXILIARY VECTOR.
!  RU  XO(NF)  VECTORS OF VARIABLES DIFFERENCE.
!  RI  GO(NF)  GRADIENTS DIFFERENCE.
!  II  IX(NF)  VECTOR CONTAINING TYPES OF BOUNDS.
!  RO  R  VALUE OF THE STEPSIZE PARAMETER.
!  RI  PO  INITIAL VALUE OF THE DIRECTIONAL DERIVATIVE.
!  II  NIT  ACTUAL NUMBER OF ITERATIONS.
!  II  KIT  NUMBER OF THE ITERATION AFTER LAST RESTART.
!  II  MET1  SELECTION OF SELF SCALING. MET1=1-SELF SCALING SUPPRESSED.
!         MET1=2-INITIAL SELF SCALING. MET1=3-SELF SCALING IN EACH
!         ITERATION.
!  II  ITERD  CAUSE OF TERMINATION IN THE DIRECTION DETERMINATION.
!         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  ITERH  TERMINATION INDICATOR. ITERH<0-BAD DECOMPOSITION.
!         ITERH=0-SUCCESSFUL UPDATE. ITERH>0-NONPOSITIVE PARAMETERS.
!  II  KBF  SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS.
!         KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS.
!
! SUBPROGRAMS USED :
!  S   MXSSMM  MATRIX-VECTOR PRODUCT.
!  S   MXSSMY  MARWILL CORRECTION OF A SPARSE SYMMETRIC MATRIX.
!  S   MXUDIF  DIFFERENCE OF TWO VECTORS.
!  S   MXUDIR  VECTOR AUGMENTED BY THE SCALED VECTOR.
!  RF  MXUDOT  DOT PRODUCT OF VECTORS.
!  S   MXVSCL  SCALING OF A VECTOR.
!
      SUBROUTINE PUSMM1 (NF, H, IH, JH, G, XS, S, XO, GO, IX, R, PO,
     &NIT, KIT, MET1, ITERD, ITERH, KBF)
      INTEGER NF,IH(*),JH(*),IX(*),NIT,KIT,MET1,ITERD,ITERH,KBF
      DOUBLE PRECISION H(*),G(*),S(*),XO(*),GO(*),XS(*),R,PO
      INTEGER MM
      DOUBLE PRECISION MXUDOT
      DOUBLE PRECISION A,B,C,GAM
      LOGICAL L1
      MM=IH(NF+1)-1
!
!     DETERMINATION OF THE PARAMETER C AND THE VECTOR S
!
      A=0.0D0
      L1=MET1.GE.3.OR.MET1.GE.2.AND.NIT.EQ.KIT
      IF (ITERD.NE.1) THEN
        CALL MXSSMM (NF, H, IH, JH, XO, S)
        IF (L1) C=MXUDOT(NF,XO,S,IX,KBF)
      ELSE
        CALL MXUDIF (NF, GO, G, S, IX, KBF)
        CALL MXVSCL (NF, R, S, S)
        IF (L1) C=-R*PO
      END IF
      GAM=1.0D0
      IF (L1) THEN
!
!     SELF SCALING
!
        B=MXUDOT(NF,XO,GO,IX,KBF)
        IF (B.GT.0.0D0.AND.C.GT.0.0D0) THEN
          GAM=C/B
          CALL MXVSCL (MM, 1.0D0/GAM, H, H)
          CALL MXVSCL (NF, 1.0D0/GAM, S, S)
        END IF
      END IF
      CALL MXUDIR (NF, -1.0D0, S, GO, S, IX, KBF)
!
!     RANK-ONE UPDATE PROJECTED USING MXSSMY
!
      CALL MXSSMY (NF, H, IH, JH, XS, S, XO)
      ITERH=0
      RETURN
      END
! SUBROUTINE PUSSD5                ALL SYSTEMS                97/12/01
! PURPOSE :
! INITIATION OF A DENSE SYMMETRIC POSITIVE DEFINITE MATRIX
!
! PARAMETERS :
!  II  NA  NUMBER OF APPROXIMATED FUNCTIONS.
!  RI  AF(NA)  VECTOR CONTAINING VALUES OF THE APPROXIMATED
!         FUNCTIONS.
!  RU  AH(MB)  POSITIVE DEFINITE APPROXIMATION OF THE PARTITIONED
!         HESSIAN MATRIX.
!  II  IAG(NA+1)  POINTERS OF THE SPARSE JACOBIAN MATRIX.
!  II  JAG(MA)  COLUMN INDICES OF THE SPARSE JACOBIAN MATRIX.
!  RU  H(M)  POSITIVE DEFINITE APPROXIMATION OF THE SPARSE HESSIAN
!         MATRIX
!  II  IH(NF+1)  POINTERS OF THE DIAGONAL ELEMENTS OF THE SPARSE
!         HESSIAN MATRIX.
!  II  JH(M)  INDICES OF THE NONZERO ELEMENTS OF THE SPARSE HESSIAN
!             MATRIX IN THE PACKED ROW FORM.
!
! SUBPROGRAMS USED :
!  S   PASSH2  COMPUTATION OF THE SPARSE HESSIAN MATRIX FROM THE
!         PARTITIONED HESSIAN MATRIX.
!
      SUBROUTINE PUSSD5 (NA, AF, AH, IAG, JAG, H, IH, JH)
      INTEGER NA,IAG(*),JAG(*),IH(*),JH(*)
      DOUBLE PRECISION AF(*),AH(*),H(*)
      INTEGER K,KA,L,LL,NB
      NB=0
      DO 10 KA=1,NA
        K=IAG(KA)
        L=IAG(KA+1)-K
        LL=L*(L+1)/2
        CALL PASSH2 (H, IH, JH, AH(NB+1), IAG, JAG, KA, AF(KA))
        NB=NB+LL
   10 CONTINUE
      RETURN
      END
! SUBROUTINE PYABU1                ALL SYSTEMS                04/12/01
! PURPOSE :
! SUBGRADIENT AGGREGATION FOR NONSMOOTH VARIABLE METRIC METHOD.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  RI  H(M)  POSITIVE DEFINITE APPROXIMATION OF THE SPARSE HESSIAN
!         MATRIX.
!  IO  JH(M)  INDICES OF THE NONZERO ELEMENTS OF H.
!  II  PSL(NF+1) POINTER ARRAY OF THE FACTORIZED SPARSE MATRIX
!  II  PERM(NF)  PERMUTATION VECTOR
!  RI  G(NF)  NEW SUBGRADIENT OF THE OBJECTIVE FUNCTION.
!  RI  GO(NF)  OLD SUBGRADIENT OF THE OBJECTIVE FUNCTION.
!  RU  GV(NF)  AGGREGATED SUBGRADIENT OF THE OBJECTIVE FUNCTION.
!  RI  S(NF)  DIRECTION VECTOR.
!  RA  U(NF)  AUXILIARY VECTOR.
!  RA  V(NF)  AUXILIARY VECTOR.
!  RO  ALF  LINEARIZATION TERM.
!  RU  ALFV  AGGREGATED LINEARIZATION TERM.
!  RI  RHO  CORRECTION PARAMETER.
!  II  JC  CORRECTION INDICATOR.
!
! SUBPROGRAMS USED :
!  S   MXSPCB  BACK SUBSTITUTION USING THE SPARSE DECOMPOSITION
!         OBTAINED BY MXSPCF.
!  RF  MXVDOT  DOT PRODUCT OF TWO VECTORS.
!  S   MXVSBP  INVERSE PERMUTATION OF A VECTOR
!  S   MXVSFP  PERMUTATION OF A VECTOR.
!
      SUBROUTINE PYABU1 (NF, H, JH, PSL, PERM, G, GO, GV, S, U, V, ALF,
     &ALFV, RHO, JC)
      INTEGER NF,JH(*),PSL(*),PERM(*),JC
      DOUBLE PRECISION H(*),G(*),GO(*),GV(*),S(*),U(*),V(*),ALF,ALFV,
     &RHO
      DOUBLE PRECISION A,B,ALFM,LAM1,LAM2,PQ,PR,PRQR,QQP,QR,RR,RRP,RRQ,
     &W,W1
      INTEGER I
      DOUBLE PRECISION ZERO,ONE,MXVDOT
      PARAMETER  (ZERO=0.0D0,ONE=1.0D0)
      ALFM=ZERO
!
!     GENERAL ROUTINE - HERE ALWAYS INPUT PARAMETER ALFM=0
!
      RR=ALFV+ALFV
      RRP=ALFV-ALFM
      RRQ=ALFV-ALF
      DO 10 I=1,NF
        A=S(I)
        U(I)=GO(I)-GV(I)
        S(I)=G(I)-GV(I)
        RR=RR-A*GV(I)
        RRP=RRP+A*U(I)
        RRQ=RRQ+A*S(I)
   10 CONTINUE
      PQ=ZERO
      PR=ZERO
      QR=ZERO
      PRQR=ZERO
      QQP=ZERO
      IF (JC.GE.1) THEN
        DO 20 I=1,NF
          PQ=PQ+RHO*(S(I)-U(I))**2
          PR=PR+RHO*U(I)**2
          QR=QR+RHO*S(I)**2
          PRQR=PRQR+RHO*U(I)*S(I)
          QQP=QQP+RHO+G(I)*(S(I)-U(I))
   20   CONTINUE
      END IF
      QQP=QQP+ALF-ALFM
      CALL MXVSFP (NF, PERM, U, V)
      CALL MXSPCB (NF, H, PSL, JH, U, 1)
      CALL MXVSFP (NF, PERM, S, V)
      CALL MXSPCB (NF, H, PSL, JH, S, 1)
      DO 30 I=1,NF
        W1=ONE/H(PSL(I)+I-1)
        PQ=PQ+W1*(S(I)-U(I))**2
        PR=PR+W1*U(I)**2
        QR=QR+W1*S(I)**2
        PRQR=PRQR+W1*U(I)*S(I)
        S(I)=W1*(S(I)-U(I))
   30 CONTINUE
      CALL MXSPCB (NF, H, PSL, JH, S, -1)
      CALL MXVSBP (NF, PERM, S, V)
      QQP=QQP+MXVDOT(NF,G,S)
      IF (PR.LE.ZERO.OR.QR.LE.ZERO) GO TO 40
      A=RRQ/QR
      B=PRQR/QR
      W=PRQR*B-PR
      IF (W.EQ.ZERO) GO TO 40
      LAM1=(A*PRQR-RRP)/W
      LAM2=A-LAM1*B
      IF (LAM1*(LAM1-ONE).LT.ZERO.AND.LAM2*(LAM1+LAM2-ONE).LT.ZERO) GO
     &TO 50
!
!     MINIMUM ON THE BOUNDARY
!
   40 LAM1=ZERO
      LAM2=ZERO
      IF (ALF.LE.ALFV) LAM2=ONE
      IF (QR.GT.ZERO) LAM2=MIN(ONE,MAX(ZERO,RRQ/QR))
      W=(LAM2*QR-RRQ-RRQ)*LAM2
      A=ZERO
      IF (ALFM.LE.ALFV) A=ONE
      IF (PR.GT.ZERO) A=MIN(ONE,MAX(ZERO,RRP/PR))
      B=(A*PR-RRP-RRP)*A
      IF (B.LT.W) THEN
        W=B
        LAM1=A
        LAM2=ZERO
      END IF
      IF (QQP*(QQP-PQ).GE.ZERO) GO TO 50
      IF (QR-RRQ-RRQ-QQP*QQP/PQ.GE.W) GO TO 50
      LAM1=QQP/PQ
      LAM2=ONE-LAM1
   50 IF (LAM1.EQ.ZERO.AND.LAM2*(LAM2-ONE).LT.ZERO.AND.RRP-LAM2*
     &PRQR.GT.ZERO.AND.PR.GT.ZERO) LAM1=MIN(ONE-LAM2,(RRP-LAM2*PRQR)/PR)
      A=ONE-LAM1-LAM2
      ALFV=LAM1*ALFM+LAM2*ALF+A*ALFV
      DO 60 I=1,NF
        GV(I)=LAM1*GO(I)+LAM2*G(I)+A*GV(I)
   60 CONTINUE
      RETURN
      END
! SUBROUTINE PYABU2                ALL SYSTEMS                04/12/01
! PURPOSE :
! SIMPLIFIED AGGREGATION FOR NONSMOOTH VARIABLE METRIC METHOD.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  RI  H(M)  POSITIVE DEFINITE APPROXIMATION OF THE SPARSE HESSIAN
!         MATRIX.
!  IO  JH(M)  INDICES OF THE NONZERO ELEMENTS OF H.
!  II  PSL(NF+1) POINTER ARRAY OF THE FACTORIZED SPARSE MATRIX
!  II  PERM(NF)  PERMUTATION VECTOR
!  RI  G(NF)  ACTUAL SUBGRADIENT OF THE OBJECTIVE FUNCTION.
!  RU  GV(NF)  AGGREGATED SUBGRADIENT OF THE OBJECTIVE FUNCTION.
!  RA  S(NF)  DIRECTION VECTOR.
!  RA  V(NF)  AUXILIARY VECTOR.
!  RO  ALF  LINEARIZATION TERM.
!  RU  ALFV  AGGREGATED LINEARIZATION TERM.
!  RI  RHO  CORRECTION PARAMETER.
!  II  JC  CORRECTION INDICATOR.
!
! SUBPROGRAMS USED :
!  S   MXSPCB  BACK SUBSTITUTION USING THE SPARSE DECOMPOSITION
!         OBTAINED BY MXSPCF.
!  S   MXVSFP  PERMUTATION OF A VECTOR.
!
      SUBROUTINE PYABU2 (NF, H, JH, PSL, PERM, G, GV, S, V, ALF, ALFV,
     &RHO, JC)
      INTEGER NF,JH(*),PSL(*),PERM(NF),JC
      DOUBLE PRECISION H(*),G(*),GV(*),S(*),V(*),ALF,ALFV,RHO
      DOUBLE PRECISION P,Q,W,LAM
      INTEGER I
      DOUBLE PRECISION ZERO,ONE
      PARAMETER  (ZERO=0.0D0,ONE=1.0D0)
      P=ALFV-ALF
      DO 10 I=1,NF
        W=S(I)
        P=P+W*S(I)
        S(I)=G(I)-GV(I)
   10 CONTINUE
      Q=ZERO
      IF (JC.GE.1) THEN
        DO 20 I=1,NF
          Q=Q+RHO*S(I)**2
   20   CONTINUE
      END IF
      CALL MXVSFP (NF, PERM, S, V)
      CALL MXSPCB (NF, H, PSL, JH, S, 1)
      DO 30 I=1,NF
        W=ONE/H(PSL(I)+I-1)
        Q=Q+W*S(I)**2
   30 CONTINUE
      LAM=0.5D0+SIGN(0.5D0,P)
      IF (Q.GT.ZERO) LAM=MIN(ONE,MAX(ZERO,P/Q))
      P=ONE-LAM
      ALFV=LAM*ALF+P*ALFV
      DO 40 I=1,NF
        GV(I)=LAM*G(I)+P*GV(I)
   40 CONTINUE
      RETURN
      END
! SUBROUTINE PYADC0                ALL SYSTEMS                98/12/01
! PURPOSE :
! NEW SIMPLE BOUNDS ARE ADDED TO THE ACTIVE SET.
!
! PARAMETERS :
!  II  NF  DECLARED NUMBER OF VARIABLES.
!  II  N  REDUCED 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.
!  IO  INEW  NUMBER OF ACTIVE CONSTRAINTS.
!
      SUBROUTINE PYADC0 (NF, N, X, IX, XL, XU, INEW)
      INTEGER NF,N,IX(NF),INEW
      DOUBLE PRECISION X(*),XL(*),XU(*)
      INTEGER I,II,IXI
      N=NF
      INEW=0
      DO 10 I=1,NF
        II=IX(I)
        IXI=ABS(II)
        IF (IXI.GE.5) THEN
          IX(I)=-IXI
        ELSE IF ((IXI.EQ.1.OR.IXI.EQ.3.OR.IXI.EQ.4).AND.X(I).LE.XL(I))
     &   THEN
          X(I)=XL(I)
          IF (IXI.EQ.4) THEN
            IX(I)=-3
          ELSE
            IX(I)=-IXI
          END IF
          N=N-1
          IF (II.GT.0) INEW=INEW+1
        ELSE IF ((IXI.EQ.2.OR.IXI.EQ.3.OR.IXI.EQ.4).AND.X(I).GE.XU(I))
     &   THEN
          X(I)=XU(I)
          IF (IXI.EQ.3) THEN
            IX(I)=-4
          ELSE
            IX(I)=-IXI
          END IF
          N=N-1
          IF (II.GT.0) INEW=INEW+1
        END IF
   10 CONTINUE
      RETURN
      END
! SUBROUTINE PYBUN1                ALL SYSTEMS                97/12/01
! PURPOSE :
! BUNDLE UPDATING.
!
! PARAMETERS :
!  II  N  ACTUAL NUMBER OF VARIABLES.
!  II  MB  DECLARED NUMBER OF LINEAR APPROXIMATED FUNCTIONS.
!  II  NB  CURRENT NUMBER OF LINEAR APPROXIMATED FUNCTIONS.
!  RU  X(N)  VECTOR OF VARIABLES.
!  RO  G(N)  SUBGRADIENT OF THE OBJECTIVE FUNCTION.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RI  AY(N*MB)  MATRIX WHOSE COLUMNS ARE VARIABLE VECTORS.
!  RI  AG(N*MB)  MATRIX WHOSE COLUMNS ARE BUNDLE SUBGRADIENTS.
!  RI  AF(4*MB)  VECTOR OF BUNDLE FUNCTIONS VALUES.
!  IO  ITERS  NULL STEP INDICATOR. ITERS=0-NULL STEP. ITERS=1-DESCENT
!         STEP.
!
! SUBPROGRAMS USED :
!  S   MXVCOP  COPYING OF A VECTOR.
!
      SUBROUTINE PYBUN1 (N, MB, NB, X, G, F, AY, AG, AF, ITERS)
      INTEGER N,MB,NB,ITERS
      DOUBLE PRECISION X(*),G(*),F,AY(*),AG(*),AF(*)
      INTEGER I,IND,K,KN,L
      L=0
      IF (ITERS.EQ.0) L=1
!
!     BUNDLE REDUCTION
!
      KN=0
      IF (NB.GE.MB) THEN
        DO 20 K=1,NB-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,NB-1
          AF(K)=AF(K+1)
          AF(K+MB*3)=AF(K+1+MB*3)
          KN=K*N+1
          CALL MXVCOP (N, AG(KN), AG(KN-N))
          CALL MXVCOP (N, AY(KN), AY(KN-N))
   40   CONTINUE
        NB=NB-1
      END IF
!
!     BUNDLE COMPLETION
!
      IF (L.GT.0.AND.KN.EQ.0) THEN
        AF(NB+1)=AF(NB)
        AF(3*MB+NB+1)=AF(3*MB+NB)
        KN=NB*N+1
        CALL MXVCOP (N, AG(KN-N), AG(KN))
        CALL MXVCOP (N, AY(KN-N), AY(KN))
      END IF
      NB=NB+1
      KN=NB-L
      AF(KN)=F
      AF(KN+MB*3)=L
      K=(KN-1)*N+1
      CALL MXVCOP (N, G, AG(K))
      CALL MXVCOP (N, X, AY(K))
      RETURN
      END
! SUBROUTINE PYCSER                ALL SYSTEMS                98/12/01
! PURPOSE :
! GROUP OF THE SAME COLOUR FOR THE POWELL-TOINT ALGORITHM FOR SPARSE
! HESSIANS APPROXIMATIONS IS CREATED.
!
! PARAMETERS :
!  IU  IH(MCOLS+1) POINTER VECTOR OF SPARSE HESSIAN MATRIX.
!  IU  JH(M) INDEX VECTOR OF THE HESSIAN MATRIX.
!  IA  WN02(MCOLS) AUXILIARY VECTOR.
!  RA  WN03(MCOLS) AUXILIARY VECTOR.
!  RI  DEG(MCOLS) DEGREES OF THE ADJACENCY GRAPH.
!  IA  WN01(NF) AUXILIARY VECTOR USED FOR INDICES OF THE COLUMNS
!        THAT HAVE NOT BEEN COLOURED YET.
!  II  COL(NF) VECTOR DISCERNING GROUPS OF THE HESSIAN COLUMN OF THE
!              SAME COLOUR.
!  IU  NCOL  NUMBER OF COLOURS USED SO FAR.
!  IU  CNM  NUMBER OF COLUMNS THAT HAVE NOT BEEN COLOURED SO FAR.
!
      SUBROUTINE PYCSER (JH, IH, WN02, WN03, DEG, WN01, COL, NCOL, CNM)
      INTEGER JH(*),IH(*),COL(*)
      INTEGER WN01(*),WN02(*)
      DOUBLE PRECISION WN03(*),DEG(*)
      INTEGER NCOL,CNM,I,J,K,L,IP
!
!     DEFINITION OF THE INCIDENCE ARRAY A
!
      L=WN01(1)
!
!     ELEMENT WAS MARKED THAT IT IS INSERTED
!
      DO 10 I=IH(L),IH(L+1)-1
        K=JH(I)
!
!     COLUMN OF THIS NUMBER HAS APPEARED IN ONE OF THE PREVIOUS GROUPS
!
        IF (COL(K).LT.NCOL) GO TO 10
        DEG(K)=DEG(K)-1
        WN02(K)=NCOL
   10 CONTINUE
!
!     COLUMN IS INSERTED
!
      COL(L)=NCOL
!
!     THE CYCLE OF COMPARING COLUMN WITH THE ARRAY A
!     A2 IS AN HELP ARRAY CONTAINING COLUMNS THAT ARE
!     BEEING EXAMINED BUT THAT WERE NOT YET ACCEPTED
!     P IS ITS POINTER
!
      IF (CNM.EQ.1) GO TO 50
      DO 40 I=2,CNM
!
!     TRANSFORMATION OF THE EXAMINED COLUMN I IS
!
        IP=1
        L=WN01(I)
        DO 20 J=IH(L),IH(L+1)-1
          K=JH(J)
          IF (COL(K).LT.NCOL) GO TO 20
          IF (WN02(K).GE.NCOL) GO TO 40
          WN03(IP)=K
          IP=IP+1
   20   CONTINUE
        IF (IP.NE.1) THEN
!
!     COPY OF THE WN03 ARRAY INTO WN02 FOR THE COLUMN WAS ACCEPTED
!
          DO 30 K=1,IP-1
            WN02(INT(WN03(K)))=NCOL
            DEG(INT(WN03(K)))=DEG(INT(WN03(K)))-1
   30     CONTINUE
        END IF
!
!     INSERT THE COLUMN INTO THE PROCESSED GROUP
!
        COL(L)=NCOL
!
!     END OF THE MAIN CYCLE
!
   40 CONTINUE
!
!     JUMP LABEL
!
   50 CONTINUE
!
!     INVP SHIFT
!
      K=1
      DO 60 I=1,CNM
        L=WN01(I)
        IF (COL(L).EQ.NCOL) THEN
        ELSE
          WN01(K)=L
          K=K+1
        END IF
   60 CONTINUE
!
!     CNM UPDATE
!
      CNM=K-1
      RETURN
      END
! SUBROUTINE PYFUT1                ALL SYSTEMS                98/12/01
! PURPOSE :
! TERMINATION CRITERIA AND TEST ON RESTART.
!
! PARAMETERS :
!  II  N  ACTUAL NUMBER OF VARIABLES.
!  RI  F  NEW VALUE OF THE OBJECTIVE FUNCTION.
!  RI  FO  OLD VALUE OF THE OBJECTIVE FUNCTION.
!  RI  UMAX  MAXIMUM ABSOLUTE VALUE OF THE NEGATIVE LAGRANGE MULTIPLIER.
!  RO  GMAX  NORM OF THE TRANSFORMED GRADIENT.
!  RI  DMAX  MAXIMUM RELATIVE DIFFERENCE OF VARIABLES.
!  RI  TOLX  LOWER BOUND FOR STEPLENGTH.
!  RI  TOLF  LOWER BOUND FOR FUNCTION DECREASE.
!  RI  TOLB  LOWER BOUND FOR FUNCTION VALUE.
!  RI  TOLG  LOWER BOUND FOR GRADIENT.
!  II  KD  DEGREE OF REQUIRED DERIVATIVES.
!  IU  NIT  ACTUAL NUMBER OF ITERATIONS.
!  II  KIT  NUMBER OF THE ITERATION AFTER RESTART.
!  II  MIT  MAXIMUM NUMBER OF ITERATIONS.
!  IU  NFV  ACTUAL NUMBER OF COMPUTED FUNCTION VALUES.
!  II  MFV  MAXIMUM NUMBER OF COMPUTED FUNCTION VALUES.
!  IU  NFG  ACTUAL NUMBER OF COMPUTED GRADIENT VALUES.
!  II  MFG  MAXIMUM NUMBER OF COMPUTED GRADIENT VALUES.
!  IU  NTESX  ACTUAL NUMBER OF TESTS ON STEPLENGTH.
!  II  MTESX  MAXIMUM NUMBER OF TESTS ON STEPLENGTH.
!  IU  NTESF  ACTUAL NUMBER OF TESTS ON FUNCTION DECREASE.
!  II  MTESF  MAXIMUM NUMBER OF TESTS ON FUNCTION DECREASE.
!  II  IRES1  RESTART SPECIFICATION. RESTART IS PERFORMED AFTER
!         IRES1*N+IRES2 ITERATIONS.
!  II  IRES2  RESTART SPECIFICATION. RESTART IS PERFORMED AFTER
!         IRES1*N+IRES2 ITERATIONS.
!  IU  IREST  RESTART INDICATOR. RESTART IS PERFORMED IF IREST>0.
!  II  ITERS  TERMINATION INDICATOR FOR STEPLENGTH DETERMINATION.
!         ITERS=0 FOR ZERO STEP.
!  IO  ITERM  TERMINATION INDICATOR. ITERM=1-TERMINATION AFTER MTESX
!         UNSUFFICIENT STEPLENGTHS. ITERM=2-TERMINATION AFTER MTESF
!         UNSUFFICIENT FUNCTION DECREASES. ITERM=3-TERMINATION ON LOWER
!         BOUND FOR FUNCTION VALUE. ITERM=4-TERMINATION ON LOWER BOUND
!         FOR GRADIENT. ITERM=11-TERMINATION AFTER MAXIMUM NUMBER OF
!         ITERATIONS. ITERM=12-TERMINATION AFTER MAXIMUM NUMBER OF
!         COMPUTED FUNCTION VALUES.
!
      SUBROUTINE PYFUT1 (N, F, FO, UMAX, GMAX, DMAX, TOLX, TOLF, TOLB,
     &TOLG, KD, NIT, KIT, MIT, NFV, MFV, NFG, MFG, NTESX, MTESX, NTESF,
     &MTESF, ITES, IRES1, IRES2, IREST, ITERS, ITERM)
      INTEGER N,KD,NIT,KIT,MIT,NFV,MFV,NFG,MFG,NTESX,MTESX,NTESF,MTESF,
     &ITES,IRES1,IRES2,IREST,ITERS,ITERM
      DOUBLE PRECISION F,FO,UMAX,GMAX,DMAX,TOLX,TOLF,TOLG,TOLB
      DOUBLE PRECISION TEMP
      IF (ITERM.LT.0) RETURN
      IF (ITES.LE.0) GO TO 10
      IF (ITERS.EQ.0) GO TO 10
      IF (NIT.LE.0) FO=F+MIN(SQRT(ABS(F)),ABS(F)/1.0D1)
      IF (F.LE.TOLB) THEN
        ITERM=3
        RETURN
      END IF
      IF (KD.GT.0) THEN
        IF (GMAX.LE.TOLG.AND.UMAX.LE.TOLG) THEN
          ITERM=4
          RETURN
        END IF
      END IF
      IF (NIT.LE.0) THEN
        NTESX=0
        NTESF=0
      END IF
      IF (DMAX.LE.TOLX) THEN
        ITERM=1
        NTESX=NTESX+1
        IF (NTESX.GE.MTESX) RETURN
      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) RETURN
      ELSE
        NTESF=0
      END IF
   10 IF (NIT.GE.MIT) THEN
        ITERM=11
        RETURN
      END IF
      IF (NFV.GE.MFV) THEN
        ITERM=12
        RETURN
      END IF
      IF (NFG.GE.MFG) THEN
        ITERM=13
        RETURN
      END IF
      ITERM=0
      IF (N.GT.0.AND.NIT-KIT.GE.IRES1*N+IRES2) THEN
        IREST=MAX(IREST,1)
      END IF
      NIT=NIT+1
      RETURN
      END
! SUBROUTINE PYFUT8                ALL SYSTEMS                98/12/01
! PURPOSE :
! TERMINATION CRITERIA AND TEST ON RESTART.
!
! PARAMETERS :
!  II  N  ACTUAL NUMBER OF VARIABLES.
!  RI  F  NEW VALUE OF THE OBJECTIVE FUNCTION.
!  RI  FO  OLD VALUE OF THE OBJECTIVE FUNCTION.
!  RO  GMAX  NORM OF THE TRANSFORMED GRADIENT.
!  RI  DMAX  MAXIMUM RELATIVE DIFFERENCE OF VARIABLES.
!  RI  RPF3  VALUE OF THE BARRIER PARAMETER.
!  RI  TOLX  LOWER BOUND FOR STEPLENGTH.
!  RI  TOLF  LOWER BOUND FOR FUNCTION DECREASE.
!  RI  TOLB  LOWER BOUND FOR FUNCTION VALUE.
!  RI  TOLG  LOWER BOUND FOR GRADIENT.
!  RI  TOLP  LOWER BOUND FOR BARRIER PARAMETER.
!  II  KD  DEGREE OF REQUIRED DERIVATIVES.
!  IU  NIT  ACTUAL NUMBER OF ITERATIONS.
!  II  KIT  NUMBER OF THE ITERATION AFTER RESTART.
!  II  MIT  MAXIMUM NUMBER OF ITERATIONS.
!  IU  NFV  ACTUAL NUMBER OF COMPUTED FUNCTION VALUES.
!  II  MFV  MAXIMUM NUMBER OF COMPUTED FUNCTION VALUES.
!  IU  NFG  ACTUAL NUMBER OF COMPUTED GRADIENT VALUES.
!  II  MFG  MAXIMUM NUMBER OF COMPUTED GRADIENT VALUES.
!  IU  NTESX  ACTUAL NUMBER OF TESTS ON STEPLENGTH.
!  II  MTESX  MAXIMUM NUMBER OF TESTS ON STEPLENGTH.
!  IU  NTESF  ACTUAL NUMBER OF TESTS ON FUNCTION DECREASE.
!  II  MTESF  MAXIMUM NUMBER OF TESTS ON FUNCTION DECREASE.
!  II  IRES1  RESTART SPECIFICATION. RESTART IS PERFORMED AFTER
!         IRES1*N+IRES2 ITERATIONS.
!  II  IRES2  RESTART SPECIFICATION. RESTART IS PERFORMED AFTER
!         IRES1*N+IRES2 ITERATIONS.
!  IU  IREST  RESTART INDICATOR. RESTART IS PERFORMED IF IREST>0.
!  II  ITERS  TERMINATION INDICATOR FOR STEPLENGTH DETERMINATION.
!         ITERS=0 FOR ZERO STEP.
!  IO  ITERM  TERMINATION INDICATOR. ITERM=1-TERMINATION AFTER MTESX
!         UNSUFFICIENT STEPLENGTHS. ITERM=2-TERMINATION AFTER MTESF
!         UNSUFFICIENT FUNCTION DECREASES. ITERM=3-TERMINATION ON LOWER
!         BOUND FOR FUNCTION VALUE. ITERM=4-TERMINATION ON LOWER BOUND
!         FOR GRADIENT. ITERM=11-TERMINATION AFTER MAXIMUM NUMBER OF
!         ITERATIONS. ITERM=12-TERMINATION AFTER MAXIMUM NUMBER OF
!         COMPUTED FUNCTION VALUES.
!
      SUBROUTINE PYFUT8 (N, F, FO, GMAX, DMAX, RPF3, TOLX, TOLF, TOLB,
     &TOLG, TOLP, KD, NIT, KIT, MIT, NFV, MFV, NFG, MFG, NTESX, MTESX,
     &NTESF, MTESF, IRES1, IRES2, IREST, ITERS, ITERM)
      INTEGER N,KD,NIT,KIT,MIT,NFV,MFV,NFG,MFG,NTESX,MTESX,NTESF,MTESF,
     &IRES1,IRES2,IREST,ITERS,ITERM
      DOUBLE PRECISION F,FO,RPF3,GMAX,DMAX,TOLX,TOLF,TOLG,TOLB,TOLP
      DOUBLE PRECISION TEMP
      IF (ITERM.LT.0) RETURN
      IF (ITERS.EQ.0) GO TO 10
      IF (NIT.LE.0) FO=F+MIN(SQRT(ABS(F)),ABS(F)/1.0D1)
      IF (F.LE.TOLB) THEN
        ITERM=3
        RETURN
      END IF
      IF (RPF3.GT.TOLP) GO TO 10
      IF (KD.GT.0) THEN
        IF (GMAX.LE.TOLG) THEN
          ITERM=4
          RETURN
        END IF
      END IF
      IF (NIT.LE.0) THEN
        NTESX=0
        NTESF=0
      END IF
      IF (DMAX.LE.TOLX) THEN
        ITERM=1
        NTESX=NTESX+1
        IF (NTESX.GE.MTESX) RETURN
      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) RETURN
      ELSE
        NTESF=0
      END IF
   10 IF (NIT.GE.MIT) THEN
        ITERM=11
        RETURN
      END IF
      IF (NFV.GE.MFV) THEN
        ITERM=12
        RETURN
      END IF
      IF (NFG.GE.MFG) THEN
        ITERM=13
        RETURN
      END IF
      ITERM=0
      IF (N.GT.0.AND.NIT-KIT.GE.IRES1*N+IRES2) THEN
        IREST=MAX(IREST,1)
      END IF
      NIT=NIT+1
      RETURN
      END
! SUBROUTINE PYPTSH                ALL SYSTEMS                98/12/01
! PURPOSE :
! POWELL-TOINT GRAPH COLORING ALGORITHM FOR GROUPING COLUMNS OF THE
! HESSIAN MATRIX BEFORE NUMERICAL DIFFERENTIATION.
!
! PARAMETERS :
!  II  NF  DECLARED NUMBER OF VARIABLES.
!  II  MMAX  MAXIMUM NUMBER OF NONZERO ELEMENTS.
!  II  IH(NF+1) POINTER VECTOR OF SPARSE HESSIAN MATRIX.
!  II  JH(MMAX) INDEX VECTOR OF THE HESSIAN MATRIX.
!  IO  COL(NF) VECTOR DISCERNING GROUPS OF THE HESSIAN COLUMN OF THE
!              SAME COLOUR.
!  RA  DEG(NF) DEGREES OF THE ADJACENCY GRAPH.
!  RA  ORD(NF) AUXILIARY ARRAY.
!  RA  RADIX(NF+1) AUXILIARY ARRAY.
!  IA  WN11(NF) AUXILIARY VECTOR USED FOR INDICES OF THE COLUMNS
!        THAT HAVE NOT BEEN COLOURED YET.
!  IA  WN12(NF) AUXILIARY VECTOR.
!  RA  XS(NF) AUXILIARY VECTOR.
!  IO  ITERM  TERMINATION INDICATOR.
!
! SUBPROGRAMS USED :
!  S   PYCSER  GROUPING COLUMNS OF THE SPARSE SYMMETRIC MATRIX.
!  S   MXSTG1  WIDTHEN THE STRUCTURE.
!  S   MXSTL1  SHRINK THE STRUCTURE.
!  S   MXVSR2  SORT.
!
      SUBROUTINE PYPTSH (NF, MMAX, IH, JH, COL, DEG, ORD, RADIX, WN11,
     &WN12, XS, ITERM)
      INTEGER NF,MMAX,IH(*),JH(*),COL(*)
      INTEGER WN11(*),WN12(*),ITERM
      DOUBLE PRECISION RADIX(*),ORD(*)
      DOUBLE PRECISION XS(*),DEG(*)
      INTEGER NCOL,CNM,I,ML,MM,J,K1,L
!
!     SAVE SYMBOLIC STRUCTURE OF FACTOR
!
      MM=IH(NF+1)-1
      IF (2*MM-NF+2.GE.MMAX) THEN
        ITERM=-45
        RETURN
      END IF
!
!     WIDTHEN THE STRUCTURE
!
      CALL MXSTG1 (NF, ML, IH, JH, WN12, WN11)
      DO 10 I=1,NF
        COL(I)=NF
        WN12(I)=0
        WN11(I)=I
   10 CONTINUE
!
!     NUMBER OF THE FREE COLUMNS
!
      CNM=NF
!
!     NUMBER OF USED COLOURS
!
      NCOL=1
!
!     DEGREE RECOUNT
!
      K1=1
      DO 20 I=1,NF
        L=IH(I+1)
        DEG(I)=L-K1
        K1=L
   20 CONTINUE
!
!     COLUMN RESORT
!
   30 CALL MXVSR2 (NF, DEG, ORD, RADIX, WN11, CNM)
!
!     ORD REWRITE INTO THE ARRAY INVP
!
      DO 40 I=1,CNM
        WN11(I)=ORD(I)
   40 CONTINUE
!
!     COLUMNS OF THE NEW COLOUR NCOL
!
      CALL PYCSER (JH, IH, WN12, XS, DEG, WN11, COL, NCOL, CNM)
!
!     STOP TEST
!
      IF (CNM.GE.1) THEN
        NCOL=NCOL+1
        GO TO 30
      END IF
!
!     SHRINK THE STRUCTURE
!
      CALL MXSTL1 (NF, ML, IH, JH, WN12)
!
!     INTO COL GIVE INDICES OF THE INDIVIDUAL GROUPS ONE AFTER ANOTHER,
!     END OF THE GROUP IS MARKED BY THE NEGATIVE INDEX VALUE.
!
!
!     READ COL
!
      DO 50 I=1,NF
        WN11(I)=0
   50 CONTINUE
      DO 60 I=1,NF
        J=COL(I)
        WN11(J)=WN11(J)+1
   60 CONTINUE
      WN12(1)=1
      L=1
      DO 70 I=2,NF
        L=L+WN11(I-1)
        WN12(I)=L
        IF (WN11(I).EQ.0) GO TO 80
   70 CONTINUE
   80 CONTINUE
!
!     CHANGE COL
!
      DO 90 I=1,NF
        J=COL(I)
        WN11(I)=J
   90 CONTINUE
      DO 100 I=1,NF
        J=WN11(I)
        COL(WN12(J))=I
        WN12(J)=WN12(J)+1
  100 CONTINUE
      DO 110 I=1,NCOL
        L=WN12(I)-1
        IF (L.GT.NF) GO TO 120
        COL(L)=-COL(L)
  110 CONTINUE
  120 CONTINUE
      RETURN
      END
! SUBROUTINE PYRMC0                ALL SYSTEMS                98/12/01
! PURPOSE :
! OLD SIMPLE BOUND IS REMOVED FROM THE ACTIVE SET. TRANSFORMED
! GRADIENT OF THE OBJECTIVE FUNCTION IS UPDATED.
!
! PARAMETERS :
!  II  NF  DECLARED NUMBER OF VARIABLES.
!  II  N  REDUCED NUMBER OF VARIABLES.
!  II  IX(NF)  VECTOR CONTAINING TYPES OF BOUNDS.
!  RI  G(NF)  GRADIENT OF THE OBJECTIVE FUNCTION.
!  RI  EPS8  TOLERANCE FOR CONSTRAINT TO BE REMOVED.
!  RI  UMAX  MAXIMUM ABSOLUTE VALUE OF THE NEGATIVE LAGRANGE MULTIPLIER.
!  RI  GMAX  NORM OF THE TRANSFORMED GRADIENT.
!  RO  RMAX  MAXIMUM VALUE OF THE STEPSIZE PARAMETER.
!  II  IOLD  NUMBER OF REMOVED CONSTRAINTS.
!  IU  IREST  RESTART INDICATOR.
!
      SUBROUTINE PYRMC0 (NF, N, IX, G, EPS8, UMAX, GMAX, RMAX, IOLD,
     &IREST)
      INTEGER NF,N,IX(*),IOLD,IREST
      DOUBLE PRECISION G(*),EPS8,UMAX,GMAX,RMAX
      INTEGER I,IXI
      IF (N.EQ.0.OR.RMAX.GT.0.0D0) THEN
        IF (UMAX.GT.EPS8*GMAX) THEN
          IOLD=0
          DO 10 I=1,NF
            IXI=IX(I)
            IF (IXI.GE.0) THEN
            ELSE IF (IXI.LE.-5) THEN
            ELSE IF ((IXI.EQ.-1.OR.IXI.EQ.-3).AND.-G(I).LE.0.0D0) THEN
            ELSE IF ((IXI.EQ.-2.OR.IXI.EQ.-4).AND.G(I).LE.0.0D0) THEN
            ELSE
              IOLD=IOLD+1
              IX(I)=MIN(ABS(IX(I)),3)
              IF (RMAX.EQ.0) GO TO 20
            END IF
   10     CONTINUE
   20     IF (IOLD.GT.1) IREST=MAX(IREST,1)
        END IF
      END IF
      RETURN
      END
! SUBROUTINE PYTCAB             ALL SYSTEMS                   06/12/01
! PURPOSE :
! VECTORS OF VARIABLES DIFFERENCE AND GRADIENTS DIFFERENCE ARE COMPUTED
! AND SCALED. TEST VALUE DMAX IS DETERMINED.
!
! PARAMETERS :
!  II  NC  NUMBER OF APPROXIMATED FUNCTIONS.
!  II  MC  NUMBER OF NONZERO ELEMENTS IN THE FIELD CG.
!  RI  CG(MC)  JACOBIAN MATRIX OF THE APPROXIMATED FUNCTIONS.
!  RO  CGO(MC)  SAVED JACOBIAN MATRIX OF THE APPROXIMATED FUNCTIONS.
!  RI  ICG(NC+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD CG.
!  RI  CZ(NC)  VECTOR CONTAINING LAGRANGE MULTIPLIERS FOR CONSTRAINTS.
!  II  ITERS  TERMINATION INDICATOR FOR STEPLENGTH DETERMINATION.
!         ITERS=0 FOR ZERO STEP.
!  II  JOB  SUBJECTS OF UPDATES. JOB=0-CONSTRAINT FUNCTIONS.
!         JOB=1-CONSTRAINT FUNCTIONS MULTIPLIED BY SIGNS OF THE
!         LAGRANGIAN MULTIPLIERS. JOB-2-TERMS OF THE LAGRANGIAN
!         FUNCTION.
!
! SUBPROGRAMS USED :
!  S   MXVDIF  DIFFERENCE OF TWO VECTORS.
!  S   MXVSAV  DIFFERENCE OF TWO VECTORS WITH COPYING AND SAVING THE
!         SUBSTRACTED ONE.
!
      SUBROUTINE PYTCAB (NC, MC, CG, CGO, ICG, CZ, ITERS, JOB)
      INTEGER NC,MC,ICG(*),ITERS,JOB
      DOUBLE PRECISION CG(*),CGO(*),CZ(*)
      INTEGER J,K,KC,L,M
      DOUBLE PRECISION TEMP
      IF (ITERS.GT.0) THEN
        CALL MXVDIF (MC, CG, CGO, CGO)
      ELSE
        CALL MXVSAV (MC, CG, CGO)
      END IF
      DO 20 KC=1,NC
        M=ICG(KC)
        L=ICG(KC+1)-M
        IF (JOB.GT.0) THEN
          TEMP=CZ(KC)
          IF (JOB.EQ.1) TEMP=SIGN(1.0D0,TEMP)
          K=M
          DO 10 J=1,L
            CGO(K)=CGO(K)*TEMP
            K=K+1
   10     CONTINUE
        END IF
   20 CONTINUE
      RETURN
      END
! SUBROUTINE PYTCUB             ALL SYSTEMS                   06/12/01
! PURPOSE :
! VECTORS OF VARIABLES DIFFERENCE AND GRADIENTS DIFFERENCE ARE COMPUTED
! AND SCALED. TEST VALUE DMAX IS DETERMINED.
!
! PARAMETERS :
!  II  NC  NUMBER OF APPROXIMATED FUNCTIONS.
!  II  MC  NUMBER OF NONZERO ELEMENTS IN THE FIELD CG.
!  RI  CG(MC)  JACOBIAN MATRIX OF THE APPROXIMATED FUNCTIONS.
!  RO  CGO(MC)  SAVED JACOBIAN MATRIX OF THE APPROXIMATED FUNCTIONS.
!  RI  ICG(NC+1)  POSITION OF THE FIRST ROWS ELEMENTS IN THE FIELD CG.
!  II  IC(NC)  VECTOR CONTAINING TYPES OF CONSTRAINTS.
!  RI  CZL(NC)  VECTOR CONTAINING LOWER MULTIPLIERS FOR CONSTRAINTS.
!  RI  CZU(NC)  VECTOR CONTAINING UPPER MULTIPLIERS FOR CONSTRAINTS.
!  II  ITERS  TERMINATION INDICATOR FOR STEPLENGTH DETERMINATION.
!         ITERS=0 FOR ZERO STEP.
!  II  JOB  SUBJECTS OF UPDATES. JOB=0-CONSTRAINT FUNCTIONS.
!         JOB=1-CONSTRAINT FUNCTIONS MULTIPLIED BY SIGNS OF THE
!         LAGRANGIAN MULTIPLIERS. JOB-2-TERMS OF THE LAGRANGIAN
!         FUNCTION.
!
! SUBPROGRAMS USED :
!  S   MXVDIF  DIFFERENCE OF TWO VECTORS.
!  S   MXVSAV  DIFFERENCE OF TWO VECTORS WITH COPYING AND SAVING THE
!         SUBSTRACTED ONE.
!
      SUBROUTINE PYTCUB (NC, MC, CG, CGO, ICG, IC, CZL, CZU, ITERS, JOB)
      INTEGER NC,MC,ICG(NC+1),IC(NC),ITERS,JOB
      DOUBLE PRECISION CG(*),CGO(*),CZL(*),CZU(*)
      INTEGER J,K,KC,KK,L,M
      DOUBLE PRECISION TEMP
      IF (ITERS.GT.0) THEN
        CALL MXVDIF (MC, CG, CGO, CGO)
      ELSE
        CALL MXVSAV (MC, CG, CGO)
      END IF
      DO 20 KC=1,NC
        M=ICG(KC)
        L=ICG(KC+1)-M
        IF (JOB.GT.0) THEN
          KK=ABS(IC(KC))
          IF (KK.EQ.3.OR.KK.EQ.4) THEN
            TEMP=CZU(KC)-CZL(KC)
          ELSE IF (KK.EQ.1) THEN
            TEMP=-CZL(KC)
          ELSE IF (KK.EQ.2) THEN
            TEMP=CZU(KC)
          ELSE IF (KK.EQ.5) THEN
            TEMP=CZL(KC)
          END IF
          IF (JOB.EQ.1) TEMP=SIGN(1.0D0,TEMP)
          K=M
          DO 10 J=1,L
            CGO(K)=CGO(K)*TEMP
            K=K+1
   10     CONTINUE
        END IF
   20 CONTINUE
      RETURN
      END
! SUBROUTINE PYTRCD             ALL SYSTEMS                   98/12/01
! PURPOSE :
! VECTORS OF VARIABLES DIFFERENCE AND GRADIENTS DIFFERENCE ARE COMPUTED
! AND SCALED AND REDUCED. TEST VALUE DMAX IS DETERMINED.
!
! PARAMETERS :
!  II  NF DECLARED NUMBER OF VARIABLES.
!  RI  X(NF)  VECTOR OF VARIABLES.
!  II  IX(NF)  VECTOR CONTAINING TYPES OF BOUNDS.
!  RU  XO(NF)  VECTORS OF VARIABLES DIFFERENCE.
!  RI  G(NF)  GRADIENT OF THE OBJECTIVE FUNCTION.
!  RU  GO(NF)  GRADIENTS DIFFERENCE.
!  RO  R  VALUE OF THE STEPSIZE PARAMETER.
!  RO  F  NEW VALUE OF THE OBJECTIVE FUNCTION.
!  RI  FO  OLD VALUE OF THE OBJECTIVE FUNCTION.
!  RO  P  NEW VALUE OF THE DIRECTIONAL DERIVATIVE.
!  RI  PO  OLD VALUE OF THE DIRECTIONAL DERIVATIVE.
!  RO  DMAX  MAXIMUM RELATIVE DIFFERENCE OF VARIABLES.
!  II  KBF  SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS.
!         KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS.
!  IO  KD  DEGREE OF REQUIRED DERIVATIVES.
!  IO  LD  DEGREE OF COMPUTED DERIVATIVES.
!  II  ITERS  TERMINATION INDICATOR FOR STEPLENGTH DETERMINATION.
!         ITERS=0 FOR ZERO STEP.
!
! SUBPROGRAMS USED :
!  S   MXVDIF  DIFFERENCE OF TWO VECTORS.
!  S   MXVSAV  DIFFERENCE OF TWO VECTORS WITH COPYING AND SAVING THE
!         SUBSTRACTED ONE.
!
      SUBROUTINE PYTRCD (NF, X, IX, XO, G, GO, R, F, FO, P, PO, DMAX,
     &KBF, KD, LD, ITERS)
      INTEGER NF,IX(*),KBF,KD,LD,ITERS
      DOUBLE PRECISION X(*),XO(*),G(*),GO(*),R,F,FO,P,PO,DMAX
      INTEGER I
      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)
        LD=KD
      END IF
      DMAX=0.0D0
      DO 10 I=1,NF
        IF (KBF.GT.0) THEN
          IF (IX(I).LT.0) THEN
            XO(I)=0.0D0
            GO(I)=0.0D0
            GO TO 10
          END IF
        END IF
        DMAX=MAX(DMAX,ABS(XO(I))/MAX(ABS(X(I)),1.0D0))
   10 CONTINUE
      RETURN
      END
! SUBROUTINE PYTRCG                ALL SYSTEMS                99/12/01
! 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  IX(NF)  VECTOR CONTAINING TYPES OF BOUNDS.
!  RI  G(NF)  GRADIENT OF THE OBJECTIVE FUNCTION.
!  RI  UMAX  MAXIMUM 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  IOLD  INDEX OF THE REMOVED CONSTRAINT.
!
! SUBPROGRAMS USED :
!  RF  MXVMAX  L-INFINITY NORM OF A VECTOR.
!
      SUBROUTINE PYTRCG (NF, N, IX, G, UMAX, GMAX, KBF, IOLD)
      INTEGER NF,N,IX(*),KBF,IOLD
      DOUBLE PRECISION G(*),UMAX,GMAX
      DOUBLE PRECISION TEMP,MXVMAX
      INTEGER I
      IF (KBF.GT.0) THEN
        GMAX=0.0D0
        UMAX=0.0D0
        IOLD=0
        DO 10 I=1,NF
          TEMP=G(I)
          IF (IX(I).GE.0) THEN
            GMAX=MAX(GMAX,ABS(TEMP))
          ELSE IF (IX(I).LE.-5) THEN
          ELSE IF ((IX(I).EQ.-1.OR.IX(I).EQ.-3).AND.UMAX+TEMP.GE.0.0D0)
     &     THEN
          ELSE IF ((IX(I).EQ.-2.OR.IX(I).EQ.-4).AND.UMAX-TEMP.GE.0.0D0)
     &     THEN
          ELSE
            IOLD=I
            UMAX=ABS(TEMP)
          END IF
   10   CONTINUE
      ELSE
        UMAX=0.0D0
        GMAX=MXVMAX(NF,G)
      END IF
      N=NF
      RETURN
      END
! SUBROUTINE PYTRCS             ALL SYSTEMS                   98/12/01
! 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.
!  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.
!  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.
!  RO  RMAX  MAXIMUM VALUE OF THE STEPSIZE PARAMETER.
!  RI  ETA9  MAXIMUM FOR REAL NUMBERS.
!  II  KBF  SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS.
!         KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS.
!
! SUBPROGRAMS USED :
!  S   MXVCOP  COPYING OF A VECTOR.
!
      SUBROUTINE PYTRCS (NF, X, IX, XO, XL, XU, G, GO, S, RO, FP, FO, F,
     & PO, P, RMAX, ETA9, KBF)
      INTEGER NF,IX(*),KBF
      DOUBLE PRECISION X(*),XO(*),XL(*),XU(*),G(*),GO(*),S(*),RO,FP,FO,
     &F,PO,P,RMAX,ETA9
      INTEGER I
      FP=FO
      RO=0.0D0
      FO=F
      PO=P
      CALL MXVCOP (NF, X, XO)
      CALL MXVCOP (NF, G, GO)
      IF (KBF.GT.0) THEN
        DO 10 I=1,NF
          IF (IX(I).LT.0) THEN
            S(I)=0.0D0
          ELSE
            IF (IX(I).EQ.1.OR.IX(I).GE.3) THEN
              IF (S(I).LT.-1.0D0/ETA9) RMAX=MIN(RMAX,(XL(I)-X(I))/S(I))
            END IF
            IF (IX(I).EQ.2.OR.IX(I).GE.3) THEN
              IF (S(I).GT.1.0D0/ETA9) RMAX=MIN(RMAX,(XU(I)-X(I))/S(I))
            END IF
          END IF
   10   CONTINUE
      END IF
      RETURN
      END
! SUBROUTINE PYTSCH             ALL SYSTEMS                   99/12/01
! PURPOSE :
! HESSIAN MATRIX OF THE OBJECTIVE FUNCTION OR ITS APPROXIMATION
! IS SCALED.
!
! PARAMETERS :
!  II  NF  DECLARED NUMBER OF VARIABLES.
!  II  IX(NF)  VECTOR CONTAINING TYPES OF BOUNDS.
!  RU  H(M)  HESSIAN MATRIX OR ITS APPROXIMATION.
!  II  IH(N+1)  POINTERS OF THE DIAGONAL ELEMENTS OF H.
!  II  JH(M)  INDICES OF THE NONZERO ELEMENTS OF H.
!  II  KBF  SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS.
!         KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS.
!
      SUBROUTINE PYTSCH (NF, IX, H, IH, JH, KBF)
      INTEGER NF,IX(*),IH(*),JH(*),KBF
      DOUBLE PRECISION H(*)
      INTEGER I,J,K,JSTRT,JSTOP
      IF (KBF.GT.0) THEN
        JSTOP=0
        DO 30 I=1,NF
          JSTRT=JSTOP+1
          JSTOP=IH(I+1)-1
          IF (IX(I).GE.0) THEN
            DO 10 J=JSTRT,JSTOP
              K=JH(J)
              IF (K.LT.0) THEN
                H(J)=0.0D0
              END IF
   10       CONTINUE
          ELSE
            H(JSTRT)=1.0D0
            DO 20 J=JSTRT+1,JSTOP
              H(J)=0.0D0
   20       CONTINUE
          END IF
   30   CONTINUE
      END IF
      RETURN
      END
! SUBROUTINE MXBSBM                ALL SYSTEMS                92/12/01
! PURPOSE :
! MULTIPLICATION OF A BLOCKED SYMMETRIC MATRIX A BY A VECTOR X.
!
! PARAMETERS :
! PARAMETERS :
!  II  L  BLOCK DIMENSION.
!  RI  ABL(L*(L+1)/2)  VALUES OF NONZERO ELEMENTS OF THE GIVEN BLOCK.
!  II  JBL(L)  INDICES OF THE INDIVIDUAL BLOCKS
!  RI  X(N)  UNPACKED INPUT VECTOR.
!  RI  Y(N)  UNPACKED OR PACKED OUTPUT VECTOR EQUAL TO A*X.
!  II  JOB  FORM OF THE VECTOR Y. JOB=1-UNPACKED FORM. JOB=2-PACKED
!         FORM.
!
      SUBROUTINE MXBSBM (L, ABL, JBL, X, Y, JOB)
      INTEGER L,JBL(*),JOB
      DOUBLE PRECISION ABL(*),X(*),Y(*)
      INTEGER I,J,IP,JP,K
      DOUBLE PRECISION TEMP
      DOUBLE PRECISION ZERO
      PARAMETER  (ZERO=0.0D0)
      DO 10 I=1,L
        IP=JBL(I)
        IF (IP.GT.0) THEN
          IF (JOB.EQ.1) THEN
            Y(IP)=ZERO
          ELSE
            Y(I)=ZERO
          END IF
        END IF
   10 CONTINUE
      K=0
      DO 40 I=1,L
        IP=JBL(I)
        IF (IP.GT.0) TEMP=X(IP)
        IF (JOB.EQ.1) THEN
          DO 20 J=1,I-1
            JP=JBL(J)
            K=K+1
            IF (IP.GT.0.AND.JP.GT.0) THEN
              Y(IP)=Y(IP)+ABL(K)*X(JP)
              Y(JP)=Y(JP)+ABL(K)*TEMP
            END IF
   20     CONTINUE
          K=K+1
          IF (IP.GT.0) Y(IP)=Y(IP)+ABL(K)*TEMP
        ELSE
          DO 30 J=1,I-1
            JP=JBL(J)
            K=K+1
            IF (IP.GT.0.AND.JP.GT.0) THEN
              Y(I)=Y(I)+ABL(K)*X(JP)
              Y(J)=Y(J)+ABL(K)*TEMP
            END IF
   30     CONTINUE
          K=K+1
          IF (IP.GT.0) Y(I)=Y(I)+ABL(K)*TEMP
        END IF
   40 CONTINUE
      RETURN
      END
! SUBROUTINE MXBSBU                ALL SYSTEMS                92/12/01
! PURPOSE :
! CORRECTION OF A BLOCKED SYMMETRIC MATRIX A. THE CORRECTION IS DEFINED
! AS A:=A+ALF*X*TRANS(X) WHERE ALF IS A GIVEN SCALING FACTOR AND X IS
! A GIVEN VECTOR.
!
! PARAMETERS :
!  II  L  BLOCK DIMENSION.
!  RI  ABL(L*(L+1)/2)  VALUES OF NONZERO ELEMENTS OF THE GIVEN BLOCK.
!  II  JBL(L)  INDICES OF THE INDIVIDUAL BLOCKS
!  RI  ALF  SCALING FACTOR.
!  RI  X(N)  UNPACKED OR PACKED INPUT VECTOR.
!  II  JOB  FORM OF THE VECTOR X. JOB=1-UNPACKED FORM. JOB=2-PACKED
!         FORM.
!
      SUBROUTINE MXBSBU (L, ABL, JBL, ALF, X, JOB)
      INTEGER L,JBL(*),JOB
      DOUBLE PRECISION ABL(*),ALF,X(*)
      INTEGER I,J,IP,JP,K
      K=0
      IF (JOB.EQ.1) THEN
        DO 20 I=1,L
          IP=JBL(I)
          DO 10 J=1,I
            JP=JBL(J)
            K=K+1
            IF (IP.GT.0.AND.JP.GT.0) THEN
              ABL(K)=ABL(K)+ALF*X(IP)*X(JP)
            END IF
   10     CONTINUE
   20   CONTINUE
      ELSE
        DO 40 I=1,L
          IP=JBL(I)
          DO 30 J=1,I
            JP=JBL(J)
            K=K+1
            IF (IP.GT.0.AND.JP.GT.0) THEN
              ABL(K)=ABL(K)+ALF*X(I)*X(J)
            END IF
   30     CONTINUE
   40   CONTINUE
      END IF
      RETURN
      END
! SUBROUTINE MXBSMI                ALL SYSTEMS                91/12/01
! PURPOSE :
! BLOCKS OF THE SYMMETRIC BLOCKED MATRIX ARE SET TO THE UNIT MATRICES.
!
! PARAMETERS :
!  II  NBLKS  NUMBER OF BLOCKS OF THE MATRIX.
!  RI  ABL(NBLA)  VALUES OF THE NONZERO ELEMENTS OF THE MATRIX.
!  II  IBLBG(NBLKS+1)  BEGINNINGS OF THE BLOCKS IN THE MATRIX.
!
! SUBROUTINES USED :
!  MXDSMI  DENSE SYMMETRIC MATRIX IS SET TO THE UNIT MATRIX.
!
      SUBROUTINE MXBSMI (NBLKS, ABL, IBLBG)
      INTEGER NBLKS,IBLBG(*)
      DOUBLE PRECISION ABL(*)
      INTEGER I,K,KBEG,KLEN
      K=1
      DO 10 I=1,NBLKS
        KBEG=IBLBG(I)
        KLEN=IBLBG(I+1)-KBEG
        CALL MXDSMI (KLEN, ABL(K))
        K=K+KLEN*(KLEN+1)/2
   10 CONTINUE
      RETURN
      END
! SUBROUTINE MXDCMD               ALL SYSTEMS                91/12/01
! PURPOSE :
! MULTIPLICATION OF A COLUMNWISE STORED DENSE RECTANGULAR MATRIX A
! BY A VECTOR X AND ADDITION OF THE SCALED VECTOR ALF*Y.
!
! 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.
!  RI  ALF  SCALING FACTOR.
!  RI  Y(N)  INPUT VECTOR.
!  RO  Z(N)  OUTPUT VECTOR EQUAL TO A*X+ALF*Y.
!
! SUBPROGRAMS USED :
!  S   MXVDIR  VECTOR AUGMENTED BY THE SCALED VECTOR.
!  S   MXVSCL  SCALING OF A VECTOR.
!
      SUBROUTINE MXDCMD (N, M, A, X, ALF, Y, Z)
      INTEGER N,M
      DOUBLE PRECISION A(*),X(*),ALF,Y(*),Z(*)
      INTEGER J,K
      CALL MXVSCL (N, ALF, Y, Z)
      K=0
      DO 10 J=1,M
        CALL MXVDIR (N, X(J), A(K+1), Z, Z)
        K=K+N
   10 CONTINUE
      RETURN
      END
! SUBROUTINE MXDCMU               ALL SYSTEMS                91/12/01
! PURPOSE :
! UPDATE OF A COLUMNWISE STORED DENSE RECTANGULAR MATRIX A. THIS MATRIX
! IS UPDATED BY THE RULE A:=A+ALF*X*TRANS(Y).
!
! PARAMETERS :
!  II  N  NUMBER OF ROWS OF THE MATRIX A.
!  II  M  NUMBER OF COLUMNS OF THE MATRIX A.
!  RU  A(N*M)  RECTANGULAR MATRIX STORED COLUMNWISE IN THE
!         ONE-DIMENSIONAL ARRAY.
!  RI  ALF  SCALAR PARAMETER.
!  RI  X(N)  INPUT VECTOR.
!  RI  Y(M)  INPUT VECTOR.
!
      SUBROUTINE MXDCMU (N, M, A, ALF, X, Y)
      INTEGER N,M
      DOUBLE PRECISION A(*),ALF,X(*),Y(*)
      DOUBLE PRECISION TEMP
      INTEGER I,J,K
      K=0
      DO 20 J=1,M
        TEMP=ALF*Y(J)
        DO 10 I=1,N
          A(K+I)=A(K+I)+TEMP*X(I)
   10   CONTINUE
        K=K+N
   20 CONTINUE
      RETURN
      END
! SUBROUTINE MXDCMV               ALL SYSTEMS                91/12/01
! PURPOSE :
! RANK-TWO UPDATE OF A COLUMNWISE STORED DENSE RECTANGULAR MATRIX A.
! THIS MATRIX IS UPDATED BY THE RULE A:=A+ALF*X*TRANS(U)+BET*Y*TRANS(V).
!
! PARAMETERS :
!  II  N  NUMBER OF ROWS OF THE MATRIX A.
!  II  M  NUMBER OF COLUMNS OF THE MATRIX A.
!  RU  A(N*M)  RECTANGULAR MATRIX STORED COLUMNWISE IN THE
!         ONE-DIMENSIONAL ARRAY.
!  RI  ALF  SCALAR PARAMETER.
!  RI  X(N)  INPUT VECTOR.
!  RI  U(M)  INPUT VECTOR.
!  RI  BET  SCALAR PARAMETER.
!  RI  Y(N)  INPUT VECTOR.
!  RI  V(M)  INPUT VECTOR.
!
      SUBROUTINE MXDCMV (N, M, A, ALF, X, U, BET, Y, V)
      INTEGER N,M
      DOUBLE PRECISION A(*),ALF,X(*),U(*),BET,Y(*),V(*)
      DOUBLE PRECISION TEMPA,TEMPB
      INTEGER I,J,K
      K=0
      DO 20 J=1,M
        TEMPA=ALF*U(J)
        TEMPB=BET*V(J)
        DO 10 I=1,N
          A(K+I)=A(K+I)+TEMPA*X(I)+TEMPB*Y(I)
   10   CONTINUE
        K=K+N
   20 CONTINUE
      RETURN
      END
! SUBROUTINE MXDPGB                ALL SYSTEMS                91/12/01
! 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)
      INTEGER JOB,N
      DOUBLE PRECISION A(*),X(*)
      INTEGER I,II,IJ,J
      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
! 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)
      DOUBLE PRECISION ALF,TAU
      INTEGER INF,N
      DOUBLE PRECISION A(*)
      DOUBLE PRECISION BET,DEL,GAM,RHO,SIG,TOL
      INTEGER I,IJ,IK,J,K,KJ,KK,L
      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 MXDRMM               ALL SYSTEMS                91/12/01
! 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)
      INTEGER N,M
      DOUBLE PRECISION A(*),X(*),Y(*)
      DOUBLE PRECISION TEMP
      INTEGER I,J,K
      DOUBLE PRECISION ZERO
      PARAMETER  (ZERO=0.0D0)
      K=0
      DO 20 J=1,M
        TEMP=ZERO
        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 MXDRCB               ALL SYSTEMS                91/12/01
! PURPOSE :
! BACKWARD PART OF THE STRANG FORMULA FOR PREMULTIPLICATION OF
! THE VECTOR X BY AN IMPLICIT BFGS UPDATE.
!
! PARAMETERS :
!  II  N  NUMBER OF ROWS OF THE MATRICES A AND B.
!  II  M  NUMBER OF COLUMNS OF THE MATRICES A AND B.
!  RI  A(N*M)  RECTANGULAR MATRIX STORED AS A ONE-DIMENSIONAL ARRAY.
!  RI  B(N*M)  RECTANGULAR MATRIX STORED AS A ONE-DIMENSIONAL ARRAY.
!  RI  U(M)  VECTOR OF SCALAR COEFFICIENTS.
!  RO  V(M)  VECTOR OF SCALAR COEFFICIENTS.
!  RU  X(N)  PREMULTIPLIED VECTOR.
!  II  IX(N)  VECTOR CONTAINING TYPES OF BOUNDS.
!  II  JOB  OPTION. IF JOB.GT.0 THEN INDEX I IS NOT USED WHENEVER
!         IX(I).LE.-1. IF JOB.LT.0 THEN INDEX I IS NOT USED WHENEVER
!         IX(I).EQ.-5.
!
! SUBPROGRAM USED :
!  S   MXUDIR  VECTOR AUGMENTED BY THE SCALED VECTOR.
!  RF  MXUDOT  DOT PRODUCT OF VECTORS.
!
! METHOD :
! H.MATTHIES, G.STRANG: THE SOLUTION OF NONLINEAR FINITE ELEMENT
! EQUATIONS. INT.J.NUMER. METHODS ENGN. 14 (1979) 1613-1626.
!
      SUBROUTINE MXDRCB (N, M, A, B, U, V, X, IX, JOB)
      INTEGER N,M,IX(*),JOB
      DOUBLE PRECISION A(*),B(*),U(*),V(*),X(*)
      DOUBLE PRECISION MXUDOT
      INTEGER I,K
      K=1
      DO 10 I=1,M
        V(I)=U(I)*MXUDOT(N,X,A(K),IX,JOB)
        CALL MXUDIR (N, -V(I), B(K), X, X, IX, JOB)
        K=K+N
   10 CONTINUE
      RETURN
      END
! SUBROUTINE MXDRCF               ALL SYSTEMS                91/12/01
! PURPOSE :
! FORWARD PART OF THE STRANG FORMULA FOR PREMULTIPLICATION OF
! THE VECTOR X BY AN IMPLICIT BFGS UPDATE.
!
! PARAMETERS :
!  II  N  NUMBER OF ROWS OF THE MATRICES A AND B.
!  II  M  NUMBER OF COLUMNS OF THE MATRICES A AND B.
!  RI  A(N*M)  RECTANGULAR MATRIX STORED AS A ONE-DIMENSIONAL ARRAY.
!  RI  B(N*M)  RECTANGULAR MATRIX STORED AS A ONE-DIMENSIONAL ARRAY.
!  RI  U(M)  VECTOR OF SCALAR COEFFICIENTS.
!  RI  V(M)  VECTOR OF SCALAR COEFFICIENTS.
!  RU  X(N)  PREMULTIPLIED VECTOR.
!  II  IX(N)  VECTOR CONTAINING TYPES OF BOUNDS.
!  II  JOB  OPTION. IF JOB.GT.0 THEN INDEX I IS NOT USED WHENEVER
!         IX(I).LE.-1. IF JOB.LT.0 THEN INDEX I IS NOT USED WHENEVER
!         IX(I).EQ.-5.
!
! SUBPROGRAM USED :
!  S   MXUDIR  VECTOR AUGMENTED BY THE SCALED VECTOR.
!  RF  MXUDOT  DOT PRODUCT OF VECTORS.
!
! METHOD :
! H.MATTHIES, G.STRANG: THE SOLUTION OF NONLINEAR FINITE ELEMENT
! EQUATIONS. INT.J.NUMER. METHODS ENGN. 14 (1979) 1613-1626.
!
      SUBROUTINE MXDRCF (N, M, A, B, U, V, X, IX, JOB)
      INTEGER N,M,IX(*),JOB
      DOUBLE PRECISION A(*),B(*),U(*),V(*),X(*)
      DOUBLE PRECISION TEMP,MXUDOT
      INTEGER I,K
      K=(M-1)*N+1
      DO 10 I=M,1,-1
        TEMP=U(I)*MXUDOT(N,X,B(K),IX,JOB)
        CALL MXUDIR (N, V(I)-TEMP, A(K), X, X, IX, JOB)
        K=K-N
   10 CONTINUE
      RETURN
      END
! SUBROUTINE MXDRSU               ALL SYSTEMS                91/12/01
! PURPOSE :
! SHIFT OF COLUMNS OF THE RECTANGULAR MATRICES A AND B. SHIFT OF
! ELEMENTS OF THE VECTOR U. THESE SHIFTS ARE USED IN THE LIMITED
! MEMORY BFGS METHOD.
!
! PARAMETERS :
!  II  N  NUMBER OF ROWS OF THE MATRIX A AND B.
!  II  M  NUMBER OF COLUMNS OF THE MATRIX A AND B.
!  RU  A(N*M)  RECTANGULAR MATRIX STORED AS A ONE-DIMENSIONAL ARRAY.
!  RU  B(N*M)  RECTANGULAR MATRIX STORED AS A ONE-DIMENSIONAL ARRAY.
!  RU  U(M)  VECTOR.
!
      SUBROUTINE MXDRSU (N, M, A, B, U)
      INTEGER N,M
      DOUBLE PRECISION A(*),B(*),U(*)
      INTEGER I,K,L
      K=(M-1)*N+1
      DO 10 I=M-1,1,-1
        L=K-N
        CALL MXVCOP (N, A(L), A(K))
        CALL MXVCOP (N, B(L), B(K))
        U(I+1)=U(I)
        K=L
   10 CONTINUE
      RETURN
      END
! SUBROUTINE MXDSMI                ALL SYSTEMS                88/12/01
! 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)
      INTEGER N
      DOUBLE PRECISION A(*)
      INTEGER I,M
      DOUBLE PRECISION ZERO,ONE
      PARAMETER  (ZERO=0.0D0,ONE=1.0D0)
      M=N*(N+1)/2
      DO 10 I=1,M
        A(I)=ZERO
   10 CONTINUE
      M=0
      DO 20 I=1,N
        M=M+I
        A(M)=ONE
   20 CONTINUE
      RETURN
      END
! SUBROUTINE MXDSMS                ALL SYSTEMS                91/12/01
! 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)
      INTEGER N
      DOUBLE PRECISION A(*),ALF
      INTEGER I,M
      M=N*(N+1)/2
      DO 10 I=1,M
        A(I)=A(I)*ALF
   10 CONTINUE
      RETURN
      END
! SUBROUTINE MXLIIM                ALL SYSTEMS                96/12/01
! PURPOSE :
! MATRIX MULTIPLICATION FOR LIMITED STORAGE INVERSE COLUMN UPDATE
! METHOD.
!
! PARAMETERS :
!  II  N  NUMBER OF VARIABLES.
!  II  M  NUMBER OF QUASI-NEWTON STEPS.
!  RI  D(N) DIAGONAL OF A DECOMPOSED TRIDIAGONAL MATRIX.
!  RI  DL(N) SUBDIAGONAL OF A DECOMPOSED TRIDIAGONAL MATRIX.
!  RI  DU(N) SUPERDIAGONAL OF A DECOMPOSED TRIDIAGONAL MATRIX.
!  RI  DU2(N) SECOND SUPERDIAGONAL OF A DECOMPOSED TRIDIAGONAL MATRIX.
!  II  ID(N)  PERMUTATION VECTOR.
!  RI  XM(N*M)  SET OF VECTORS FOR INVERSE COLUMN UPDATE.
!  RI  GM(M)  SET OF VALUES FOR INVERSE COLUMN UPDATE.
!  II  IM(M)  SET OF INDICES FOR INVERSE COLUMN UPDATE.
!  RI  U(N)  INPUT VECTOR.
!  RO  V(N)  OUTPUT VECTOR.
!
! SUBPROGRAMS USED :
!  S   MXSGIB  BACK SUBSTITUTION AFTER INCOMPLETE LU DECOMPOSITION.
!  S   MXVCOP  COPYING OF A VECTOR.
!  S   MXVDIR  VECTOR AUGMENTED BY THE SCALED VECTOR.
!
      SUBROUTINE MXLIIM (N, M, A, IA, JA, IP, ID, XM, GM, IM, U, V, S)
      INTEGER M,N
      DOUBLE PRECISION A(*),GM(*),S(*),U(*),V(*),XM(*)
      INTEGER IA(*),ID(*),IM(*),IP(*),JA(*)
      INTEGER I,L
      CALL MXVCOP (N, U, V)
      CALL MXSGIB (N, A, IA, JA, IP, ID, V, S, 0)
      L=1
      DO 10 I=1,M
        CALL MXVDIR (N, U(IM(I))/GM(I), XM(L), V, V)
        L=L+N
   10 CONTINUE
      RETURN
      END
! SUBROUTINE MXSCMD               ALL SYSTEMS                92/12/01
! PURPOSE :
! MULTIPLICATION OF A DENSE RECTANGULAR MATRIX A BY A VECTOR X AND
! ADDITIOON OF THE SCALED VECTOR ALF*Y.
!
! PARAMETERS :
!  II  N  NUMBER OF ROWS OF THE MATRIX A.
!  II  NA NUMBER OF COLUMNS OF THE MATRIX A.
!  II  MA  NUMBER OF ELEMENTS IN THE FIELD A.
!  RI  A(MA)  RECTANGULAR MATRIX STORED AS A TWO-DIMENSIONAL ARRAY.
!  II  IA(NA+1)  POSITION OF THE FIRST RORWS ELEMENTS IN THE FIELD A.
!  II  JA(MA) COLUMN INDICES OF ELEMENTS IN THE FIELD A.
!  RI  X(NA)  INPUT VECTOR.
!  RI  ALF  SCALING FACTOR.
!  RI  Y(N)  INPUT VECTOR.
!  RO  Z(N)  OUTPUT VECTOR EQUAL TO A*X+ALF*Y.
!
! SUBPROGRAMS USED :
!  S   MXVSCL  SCALING OF A VECTOR.
!
      SUBROUTINE MXSCMD (N, NA, A, IA, JA, X, ALF, Y, Z)
      INTEGER N,NA,IA(*),JA(*)
      DOUBLE PRECISION A(*),X(*),ALF,Y(*),Z(*)
      INTEGER I,J,K,L,JP
      CALL MXVSCL (N, ALF, Y, Z)
      DO 20 I=1,NA
        K=IA(I)
        L=IA(I+1)-K
        DO 10 J=1,L
          JP=JA(K)
          IF (JP.GT.0) Z(JP)=Z(JP)+A(K)*X(I)
          K=K+1
   10   CONTINUE
   20 CONTINUE
      RETURN
      END
! SUBROUTINE MXSCMM               ALL SYSTEMS                92/12/01
! PURPOSE :
! MULTIPLICATION OF A DENSE RECTANGULAR MATRIX A BY A VECTOR X.
!
! PARAMETERS :
!  II  N  NUMBER OF ROWS OF THE MATRIX A.
!  II  NA NUMBER OF COLUMNS OF THE MATRIX A.
!  II  MA  NUMBER OF ELEMENTS IN THE FIELD A.
!  RI  A(MA)  RECTANGULAR MATRIX STORED AS A TWO-DIMENSIONAL ARRAY.
!  II  IA(NA+1)  POSITION OF THE FIRST RORWS ELEMENTS IN THE FIELD A.
!  II  JA(MA) COLUMN INDICES OF ELEMENTS IN THE FIELD A.
!  RI  X(NA)  INPUT VECTOR.
!  RO  Y(N)  OUTPUT VECTOR EQUAL TO A*X.
!
! SUBPROGRAMS USED :
!  S   MXVSET  INITIATION OF A VECTOR.
!
      SUBROUTINE MXSCMM (N, NA, A, IA, JA, X, Y)
      INTEGER N,NA,IA(*),JA(*)
      DOUBLE PRECISION A(*),X(*),Y(*)
      INTEGER I,J,K,L,JP
      CALL MXVSET (N, 0.0D0, Y)
      DO 20 I=1,NA
        K=IA(I)
        L=IA(I+1)-K
        DO 10 J=1,L
          JP=JA(K)
          IF (JP.GT.0) Y(JP)=Y(JP)+A(K)*X(I)
          K=K+1
   10   CONTINUE
   20 CONTINUE
      RETURN
      END
! SUBROUTINE MXSGIB                ALL SYSTEMS                95/12/01
! PURPOSE :
! SOLUTION OF A SYSTEM OF LINEAR EQUATIONS WITH A SPARSE UNSYMMETRIC
! MATRIX A USING INCOMPLETE FACTORIZATION OBTAINED BY THE SUBROUTINE
! MXSGIF.
!
! PARAMETERS :
!  II  N  MATRIX DIMENSION.
!  II  M  NUMBER OF MATRIX NONZERO ELEMENTS.
!  RU  A(M)  NONZERO ELEMENTS OF THE MATRIX A.
!  II  IA(N+1)  ROW POINTERS OF THE MATRIX A.
!  II  JA(M)  COLUMN INDICES OF THE MATRIX A.
!  IO  IP(N)  PERMUTATION VECTOR.
!  II  ID(N) DIAGONAL POINTERS OF THE MATRIX A.
!  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.
!  RA  Y(N)  AUXILIARY VECTOR.
!  JOB  OPTION. JOB=0 - SOLUTION WITH THE ORIGINAL MATRIX.
!         JOB=1 - SOLUTION WITH THE MATRIX TRANSPOSE.
!
      SUBROUTINE MXSGIB (N, A, IA, JA, IP, ID, X, Y, JOB)
      DOUBLE PRECISION CON
      PARAMETER  (CON=1.0D120)
      INTEGER JOB,N
      DOUBLE PRECISION A(*),X(*),Y(*)
      INTEGER IA(*),ID(*),IP(*),JA(*)
      DOUBLE PRECISION APOM
      INTEGER J,JJ,JP,K,KSTOP,KSTRT
      IF (JOB.LE.0) THEN
        DO 20 K=1,N
          KSTRT=IA(K)
          KSTOP=IA(K+1)-1
          DO 10 JJ=KSTRT,KSTOP
            J=JA(JJ)
            JP=IP(J)
            IF (JP.LT.K) THEN
              X(K)=X(K)-A(JJ)*X(JP)
              IF (ABS(X(K)).GE.CON) X(K)=SIGN(CON,X(K))
            END IF
   10     CONTINUE
   20   CONTINUE
        DO 40 K=N,1,-1
          KSTRT=IA(K)
          KSTOP=IA(K+1)-1
          DO 30 JJ=KSTRT,KSTOP
            J=JA(JJ)
            JP=IP(J)
            IF (JP.GT.K) X(K)=X(K)-A(JJ)*X(JP)
            IF (JP.EQ.K) APOM=A(JJ)
   30     CONTINUE
          X(K)=X(K)/APOM
   40   CONTINUE
        CALL MXVSFP (N, IP, X, Y)
      ELSE
        CALL MXVSBP (N, IP, X, Y)
        DO 60 K=1,N
          X(K)=X(K)/A(ID(K))
          KSTRT=IA(K)
          KSTOP=IA(K+1)-1
          DO 50 JJ=KSTRT,KSTOP
            J=JA(JJ)
            JP=IP(J)
            IF (JP.GT.K) X(JP)=X(JP)-A(JJ)*X(K)
   50     CONTINUE
   60   CONTINUE
        DO 80 K=N,1,-1
          KSTRT=IA(K)
          KSTOP=IA(K+1)-1
          DO 70 JJ=KSTRT,KSTOP
            J=JA(JJ)
            JP=IP(J)
            IF (JP.LT.K) X(JP)=X(JP)-A(JJ)*X(K)
   70     CONTINUE
   80   CONTINUE
      END IF
      RETURN
      END
! SUBROUTINE MXSGIF                ALL SYSTEMS                95/12/01
! PURPOSE :
! INCOMPLETE FACTORIZATION OF A GENERAL SPARSE MATRIX A.
!
! PARAMETERS :
!  II  N  MATRIX DIMENSION.
!  II  M  NUMBER OF MATRIX NONZERO ELEMENTS.
!  RU  A(M)  NONZERO ELEMENTS OF THE MATRIX A.
!  II  IA(N+1)  ROW POINTERS OF THE MATRIX A.
!  II  JA(M)  COLUMN INDICES OF THE MATRIX A.
!  IO  IP(N)  PERMUTATION VECTOR.
!  IO  ID(N)  DIAGONAL POINTERS OF THE MATRIX A.
!  RA  IW(N)  AUXILIARY VECTOR.
!  RI  TOL  PIVOT TOLERANCE.
!  IO  INF  INFORMATION.
!
      SUBROUTINE MXSGIF (N, A, IA, JA, IP, ID, IW, TOL, INF)
      DOUBLE PRECISION ZERO,ONE,CON
      PARAMETER  (ZERO=0.0D0,ONE=1.0D0,CON=1.0D-30)
      DOUBLE PRECISION TOL
      INTEGER INF,N
      DOUBLE PRECISION A(*)
      INTEGER IA(*),ID(*),IP(*),IW(*),JA(*)
      DOUBLE PRECISION TEMP
      INTEGER I,II,J,JJ,JSTOP,JSTRT,K,KK,KSTOP,KSTRT
      INF=0
      DO 10 I=1,N
        IF (IP(I).LE.0.OR.IP(I).GT.N) THEN
          CALL MXVINP (N, IP)
          GO TO 20
        END IF
   10 CONTINUE
   20 CALL MXVINS (N, 0, IW)
      DO 70 K=1,N
        KSTRT=IA(K)
        KSTOP=IA(K+1)-1
        ID(K)=0
        DO 30 JJ=KSTRT,KSTOP
          J=JA(JJ)
          IW(J)=JJ
          IF (IP(J).EQ.K) ID(K)=JJ
   30   CONTINUE
        IF (ID(K).EQ.0) THEN
          INF=-45
          RETURN
        END IF
        IF (TOL.GT.ZERO) A(ID(K))=(ONE+TOL)*A(ID(K))
        IF (ABS(A(ID(K))).LT.TOL) A(ID(K))=A(ID(K))+SIGN(TOL,A(ID(K)))
        DO 50 JJ=KSTRT,KSTOP
          J=IP(JA(JJ))
          IF (J.LT.K) THEN
            JSTRT=IA(J)
            JSTOP=IA(J+1)-1
            TEMP=A(JJ)/A(ID(J))
            A(JJ)=TEMP
            DO 40 II=JSTRT,JSTOP
              I=JA(II)
              IF (IP(I).GT.J) THEN
                KK=IW(I)
                IF (KK.NE.0) A(KK)=A(KK)-TEMP*A(II)
              END IF
   40       CONTINUE
          END IF
   50   CONTINUE
        KK=ID(K)
        IF (ABS(A(KK)).LT.CON) THEN
          INF=K
          IF (A(KK).EQ.ZERO) THEN
            A(KK)=CON
          ELSE
            A(KK)=SIGN(CON,A(KK))
          END IF
        END IF
        DO 60 JJ=KSTRT,KSTOP
          J=JA(JJ)
          IW(J)=0
   60   CONTINUE
   70 CONTINUE
      RETURN
      END
! SUBROUTINE MXSPCA                 ALL SYSTEMS                93/12/01
! PURPOSE :
! REWRITE SYMMETRIC MATRIX INTO THE PERMUTED FACTORIZED COMPACT SCHEME.
! MOIDIFIED VERSION FOR THE USE WITH MXSPCJ.
!
! PARAMETERS:
!  II  N  SIZE OF THE SYSTEM SOLVED.
!  II  NB NUMBER OF NONZEROS IN THE UPPER TRIANGLE OF THE ORIGINAL
!         MATRIX.
!  II  ML SIZE OF THE COMPACT FACTOR.
!  RU  A(MMAX) NUMERICAL VALUES OF THE SPARSE HESSIAN APPROXIMATION
!              STORED AT THE POSITIONS 1, ...,NB.
!  IU  JA(MMAX) INDICES OF THE NONZERO ELEMENTS OF THE HESSIAN MATRIX IN
!             THE PACKED ROW FORM AT THE FIRST NB POSITIONS.
!             NEW POSITIONS
!             IN THE PERMUTED FACTOR STORED IN A(NB+1), ..., A(2*NB),
!             INDICES OF COMPACT SCHEME IN A(2*NB+1), ..., A(2*NB+ML).
!  II  PSL(N+1)  POINTER VECTOR OF THE COMPACT FORM OF THE TRIANGULAR
!             FACTOR OF THE HESSIAN APPROXIMATION.
!  RI  T  CORRECTION FACTOR THAT IS ADDED TO THE DIAGONAL.
!
!
      SUBROUTINE MXSPCA (N, NB, ML, A, IA, JA, T)
      INTEGER N,NB,ML,IA(*),JA(*)
      DOUBLE PRECISION A(*),T
      INTEGER I,J
      DO 10 I=1,N
        J=ABS(JA(IA(I)+NB+ML))
        A(NB+J)=A(NB+J)+T
   10 CONTINUE
      RETURN
      END
! SUBROUTINE MXSPCB                ALL SYSTEMS                92/12/01
! PURPOSE :
! SOLUTION OF A SYSTEM OF LINEAR EQUATIONS WITH A SPARSE SYMMETRIC
! POSITIVE DEFINITE MATRIX A+E USING THE FACTORIZATION A+E=L*D*TRANS(L)
! STORED IN THE COMPACT SCHEME. THIS FACTORIZATION CAN BE OBTAINED
! USING THE SUBROUTINE MXSPCF.
!
! PARAMETERS :
!  II  N ORDER OF THE MATRIX A.
!  RI  A(MMAX)  FACTORS L,D OF THE FACTORIZATION A+E=L*D*TRANS(L)
!                STORED USING THE COMPACT SCHEME OF STORING.
!  II  PSL(N+1) POINTER ARRAY OF THE FACTORIZED SPARSE MATRIX
!  II  SL(MMAX)  ARRAY OF COLUMN INDICES OF THE FACTORS L AND D
!         STORED USING THE COMPACT SCHEME.
!  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 MXSPCB (N, A, PSL, SL, X, JOB)
      INTEGER N
      DOUBLE PRECISION A(*),X(*)
      INTEGER PSL(*),SL(*),JOB
      INTEGER I,J,IS
!
!     FIRST PHASE
!
      IF (JOB.GE.0) THEN
        DO 20 I=1,N
          IS=SL(I)+N+1
          DO 10 J=PSL(I)+I,PSL(I+1)+I-1
            X(SL(IS))=X(SL(IS))-A(J)*X(I)
            IS=IS+1
   10     CONTINUE
   20   CONTINUE
      END IF
!
!     SECOND PHASE
!
      IF (JOB.EQ.0) THEN
        DO 30 I=1,N
          X(I)=X(I)/A(PSL(I)+I-1)
   30   CONTINUE
      END IF
!
!     THIRD PHASE
!
      IF (JOB.LE.0) THEN
        DO 50 I=N,1,-1
          IS=SL(I)+N+1
          DO 40 J=PSL(I)+I,PSL(I+1)+I-1
            X(I)=X(I)-A(J)*X(SL(IS))
            IS=IS+1
   40     CONTINUE
   50   CONTINUE
      END IF
      RETURN
      END
! SUBROUTINE MXSPCC                ALL SYSTEMS               92/12/01
! PURPOSE :
! SPARSE MATRIX REORDER, SYMBOLIC FACTORIZATION, DATA STRUCTURES
! TRANSFORMATION - INITIATION OF THE DIRECT SPARSE SOLVER.
! MODIFIED VERSION WITH CHANGED DATA STRUCTURES.
!
!  PARAMETERS :
!  II  N  ACTUAL NUMBER OF VARIABLES.
!  II  NJA  NUMBER OF NONZERO ELEMENTS OF THE MATRIX.
!  IO  ML  SIZE OF THE COMPACT STRUCTURE OF THE TRIANGULAR FACTOR
!         OF THE HESSIAN APPROXIMATION.
!  II  MMAX  SIZE OF THE ARRAYS JA,A.
!  RO  A(MMAX)   NUMERICAL VALUES OF THE SPARSE HESSIAN APPROXIMATION
!         STORED AT THE POSITIONS 1, ...,NJA. LOWER TRIANGULAR
!         FACTOR OF THE HESSIAN APPROXIMATION STORED AT THE
!         POSITIONS NJA+1, ..., NJA+MB.
!  II  IA(N) POINTERS OF THE DIAGONAL ELEMENTS OF THE HESSIAN MATRIX.
!  II  JA(MMAX)  INDICES OF THE NONZERO ELEMENTS OF THE HESSIAN MATRIX I
!         THE PACKED ROW FORM AT THE FIRST NJA POSITIONS. COMPACT
!         STRUCTURE OF INDICES OF ITS TRIANGULAR FACTOR IS ROWWISE
!         STORED.
!  II  PSL(N+1)  POINTER VECTOR OF THE COMPACT FORM OF THE TRIANGULAR
!         FACTOR OF THE HESSIAN APPROXIMATION.
!  IO  PERM(N) PERMUTATION VECTOR.
!  IO  INVP(N) INVERSE PERMUTATION VECTOR.
!  IA  WN11(N) AUXILIARY VECTOR.
!  IA  WN12(N) AUXILIARY VECTOR.
!  IA  WN13(N) AUXILIARY VECTOR.
!  IA  WN14(N) AUXILIARY VECTOR.
!  IO  ITERM  TERMINATION INDICATOR. TERMINATION IF ITERM .NE. 0.
!
!
! SUBPROGRAMS USED :
!  S   MXSTG1  WIDTHENING OF THE PACKED FORM OF THE SPARSE MATRIX.
!  S   MXSSMN  SPARSE MATRIX REORDERING.
!  S   MXVSIP  INVERSE PERMUTATION COMPUTING.
!  S   MXSPCI  SYMBOLIC FACTORIZATION.
!  S   MXSTL1  PACKING OF THE WIDTHENED FORM OF THE SPARSE MATRIX.
!
      SUBROUTINE MXSPCC (N, NJA, ML, MMAX, A, IA, JA, PSL, PERM, INVP,
     &WN11, WN12, WN13, WN14, ITERM)
      INTEGER N,NJA,MMAX,ML,ITERM
      INTEGER PERM(*),INVP(*),WN11(*),WN12(*),WN13(*),WN14(*)
      INTEGER PSL(*),IA(*),JA(*)
      INTEGER JSTRT,JSTOP,I,J,K,L,NJASAVE
      INTEGER LL,LL1,NJABIG,KSTRT
      DOUBLE PRECISION A(*)
      IF (ML.GT.0) RETURN
      IF (2*NJA.GE.MMAX) THEN
        ITERM=-41
        GO TO 190
      END IF
!
!     WIDTHENING OF THE PACKED FORM
!
      NJASAVE=NJA
      CALL MXSTG1 (N, NJA, IA, JA, WN12, WN11)
      NJABIG=NJA
!
!     REORDERING OF THE SPARSE MATRIX
!
      CALL MXSSMN (N, IA, JA, PERM, WN11, WN12, WN13)
!
!     FIND THE INVERSE PERMUTATION VECTOR INVP
!
      CALL MXVSIP (N, PERM, INVP)
!
!     SHRINK THE STRUCTURE
!
      CALL MXSTL1 (N, NJA, IA, JA, WN11)
      DO 10 I=1,N
        WN11(I)=0
        WN12(I)=0
   10 CONTINUE
!
!     WN11 CONTAINS BEGINNINGS OF THE FACTOR ROWS
!
      DO 30 I=1,N
        K=PERM(I)
        JSTRT=IA(K)
        JSTOP=IA(K+1)-1
        DO 20 J=JSTRT,JSTOP
          L=JA(J)
          L=INVP(L)
          IF (L.GE.I) THEN
            WN12(I)=WN12(I)+1
          ELSE
            WN12(L)=WN12(L)+1
          END IF
   20   CONTINUE
   30 CONTINUE
      WN11(1)=1
      DO 40 I=1,N-1
        WN11(I+1)=WN11(I)+WN12(I)
   40 CONTINUE
!
!     CREATE UPPER TRIANGULAR STRUCTURE NECESSARY FOR THE TRANSFER
!
      DO 60 I=1,N
        K=PERM(I)
        JSTRT=IA(K)
        JSTOP=IA(K+1)-1
        DO 50 J=JSTRT,JSTOP
          L=JA(J)
          L=INVP(L)
          IF (L.GE.I) THEN
            LL1=WN11(I)
            WN11(I)=LL1+1
            JA(NJABIG+LL1)=L
            A(J)=LL1
            A(NJA+LL1)=J
          ELSE
            LL1=WN11(L)
            WN11(L)=LL1+1
            JA(NJABIG+LL1)=I
            A(J)=LL1
            A(NJA+LL1)=J
          END IF
   50   CONTINUE
   60 CONTINUE
!
!     SORT INDICES IN THE PERMUTED UPPER TRIANGLE
!
      DO 70 I=1,N
        WN11(I)=0
   70 CONTINUE
      WN11(1)=1
      WN14(1)=1
      DO 80 I=2,N+1
        WN11(I)=WN11(I-1)+WN12(I-1)
        WN14(I)=WN11(I)
   80 CONTINUE
      DO 90 I=1,N
        WN12(I)=0
   90 CONTINUE
      JSTOP=WN11(N+1)
      DO 100 I=N,1,-1
        JSTRT=WN11(I)
        CALL MXVSR5 (JSTOP-JSTRT, JSTRT-1, JA(NJABIG+JSTRT), A,
     &   A(NJASAVE+JSTRT))
        JSTOP=JSTRT
  100 CONTINUE
!
!     WIDTHENING OF THE PERMUTED PACKED FORM.
!
      NJASAVE=NJA
      CALL MXSTG1 (N, NJA, IA, JA, WN12, WN11)
      NJABIG=NJA
!
!     SYMBOLIC FACTORIZATION.
!
      CALL MXSPCI (N, ML, MMAX-2*NJA, IA, JA, PSL, A(2*NJASAVE+1), PERM,
     & INVP, WN11, WN12, WN13, ITERM)
      IF (ITERM.NE.0) THEN
        ITERM=-42
        GO TO 190
      END IF
!
!     RETRIEVE PARAMETERS
!
      CALL MXSTL1 (N, NJA, IA, JA, WN11)
!
!     SHIFT PERMUTED UPPER TRIANGLE.
!
      DO 110 I=1,NJASAVE
        JA(NJA+I)=JA(NJABIG+I)
  110 CONTINUE
!
!     SHIFT STRUCTURE SL.
!
      IF (2*NJASAVE+ML.GE.MMAX) THEN
        ITERM=-41
        GO TO 190
      END IF
      DO 120 I=1,ML
        JA(2*NJASAVE+I)=A(2*NJASAVE+I)
  120 CONTINUE
!
!     SET POINTERS
!
      DO 130 I=1,N
        WN12(I)=0
  130 CONTINUE
      LL1=PSL(N)+N-1
      JSTOP=WN14(N+1)
      DO 160 I=N,1,-1
        JSTRT=WN14(I)
        DO 140 J=JSTRT,JSTOP-1
          K=JA(NJASAVE+J)
          WN12(K)=J
          LL=A(NJASAVE+J)
          WN13(K)=LL
  140   CONTINUE
        JSTOP=JSTRT
        KSTRT=JA(2*NJASAVE+I)+N+1+2*NJASAVE
        DO 150 J=KSTRT+PSL(I+1)-PSL(I)-1,KSTRT,-1
          L=JA(J)
          IF (WN12(L).NE.0) THEN
            LL=WN13(L)
            A(LL)=LL1
            WN12(L)=0
          END IF
          LL1=LL1-1
  150   CONTINUE
        K=WN12(I)
        WN12(I)=0
        LL=WN13(I)
        A(LL)=LL1
        LL1=LL1-1
  160 CONTINUE
      DO 170 I=1,ML
        JA(NJASAVE+I)=JA(2*NJASAVE+I)
  170 CONTINUE
      DO 180 I=1,NJASAVE
        JA(ML+NJASAVE+I)=A(I)
  180 CONTINUE
  190 CONTINUE
      RETURN
      END
! SUBROUTINE MXSPCD                ALL SYSTEMS                92/12/01
! PURPOSE :
! COMPUTATION OF A DIRECTION OF NEGATIVE CURVATURE WITH RESPECT TO A
! SPARSE SYMMETRIC MATRIX A USING THE FACTORIZATION A+E=L*D*TRANS(L)
! STORED IN THE COMPACT SPARSE FORM.
!
! PARAMETERS :
!  II  N ORDER OF THE MATRIX A.
!  II  MMAX  LENGTH OF THE PRINCIPAL MATRIX VECTORS (SL,A).
!  RI  A(MMAX)      FACTORIZATION A+E=L*D*TRANS(L) OBTAINED BY THE
!         SUBROUTINE MXSPGF.IT CONTAINS THE NUMERICAL VALUES OF THE
!         FACTORS STORED IN THE COMPACT FORM ACCORDING TO THE
!         INFORMATION IN THE VECTORS PSL,SL.
!  II  PSL(N+1)  POINTER VECTOR OF THE FACTORIZED MATRIX A.
!  II  SL(MMAX)  COMPACT SHEME OF THE FACTORIZED MATRIX A.
!  RO  X(N)  COMPUTED DIRECTION OF NEGATIVE CURVATURE (I.E.
!         TRANS(X)*A*X<0) IF IT EXISTS.
!  II  INF  INFORMATION OBTAINED IN THE FACTORIZATION PROCESS. THE
!         DIRECTION OF NEGATIVE CURVATURE EXISTS ONLY IF INF>0.
!
! METHOD :
! P.E.GILL, W.MURRAY : NEWTON TYPE METHODS FOR UNCONSTRAINED AND
! LINEARLY CONSTRAINED OPTIMIZATION, MATH. PROGRAMMING 28 (1974)
! PP. 311-350.
!
      SUBROUTINE MXSPCD (N, A, PSL, SL, X, INF)
      INTEGER N,INF,PSL(*),SL(*)
      DOUBLE PRECISION A(*),X(*)
      INTEGER I,J,IS
!
!     RIGHT HAND SIDE FORMATION
!
      DO 10 I=1,N
        X(I)=0.0D0
   10 CONTINUE
      IF (INF.LE.0) RETURN
      X(INF)=1.0D0
!
!     BACK SUBSTITUTION
!
      DO 30 I=INF-1,1,-1
        IS=SL(I)+N+1
        DO 20 J=PSL(I)+I,PSL(I+1)+I-1
          X(I)=X(I)-A(J)*X(SL(IS))
          IS=IS+1
   20   CONTINUE
   30 CONTINUE
      RETURN
      END
! SUBROUTINE MXSPCF                ALL SYSTEMS                90/12/01
! PURPOSE :
! NUMERICAL  FACTORIZATION A+E=L*D*TRANS(L) OF A SPARSE
! 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. THE STRUCTURE ON
! INPUT WAS OBTAINED BY THE SYMBOLIC FACTORIZATION AND IT MAKES
! USE OF THE COMPACT SCHEME OF STORING THE SPARSE MATRIX IN THE
! POINTER ARRAY PSL ,INDEX ARRAY SL. NUMERICAL VALUES OF THE FACTOR
! CAN BE FOUND IN THE ARRAY A.
!
! PARAMETERS :
!  II  N ORDER OF THE MATRIX A.
!  RU  A(MMAX) ON INPUT NUMERICAL VALUES OF THE LOWER HALF OF THE
!      MATRIX THAT IS BEEING FACTORIZED(INCLUDING THE DIAGONAL
!      ELEMENTS. ON OUTPUT IT CONTAINS FACTORS L AND D AS IF THEY
!      FORM THE LOWER HALF OF THE MATRIX.STRUCTURE INFORMATION
!      IS SAVED IN THE COMPACT SCHEME IN THE PAIR OF VECTORS PSL
!      AND SL.
!  II  PSL(NF+1) POINTER VECTOR OF THE FACTOR
!  II  SL(MMAX) STRUCTURE OF THE FACTOR IN THE COMPACT FORM
!  IA  WN11(NF+1) AUXILIARY VECTOR.
!  IA  WN12(NF+1) AUXILIARY VECTOR.
!  RA  RN01(NF+1) AUXILIARY VECTOR.
!  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 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 :
! S.C.EISENSTAT,M.C.GURSKY,M.H.SCHULTZ,A.H.SHERMAN:YALE SPARSE MATRIX
! PACKAGE I. THE SYMMETRIC CODES,YALE UNIV. RES. REPT.
! NO.112,1977.
!
      SUBROUTINE MXSPCF (N, A, PSL, SL, WN11, WN12, RN01, INF, ALF, TAU)
      INTEGER N,PSL(*),SL(*),WN11(*),WN12(*),INF
      DOUBLE PRECISION A(*),RN01(*),ALF
      DOUBLE PRECISION BET,GAM,DEL,RHO,SIG,TOL,TADD,TBDD,TAU
      INTEGER I,J,K,L,II
      INTEGER ISTRT,ISTOP,NEWK,KPB,ISUB
      L=0
      INF=0
      TOL=ALF
      ALF=0.0D0
      BET=0.0D0
      GAM=0.0D0
      TAU=0.0D0
      DO 20 I=1,N
        BET=MAX(BET,ABS(A(PSL(I)+I-1)))
        DO 10 J=PSL(I)+I,PSL(I+1)+I-1
          GAM=MAX(GAM,ABS(A(J)))
   10   CONTINUE
   20 CONTINUE
      BET=MAX(TOL,BET,GAM/N)
      DEL=TOL*BET
      DO 30 I=1,N
        WN11(I)=0
        RN01(I)=0.0D0
   30 CONTINUE
      DO 110 J=1,N
!
!     DETERMINATION OF A DIAGONAL CORRECTION
!
        SIG=A(PSL(J)+J-1)
        RHO=0.0D0
        NEWK=WN11(J)
   40   K=NEWK
        IF (K.EQ.0) GO TO 60
        NEWK=WN11(K)
        KPB=WN12(K)
        TADD=A(KPB+K)
        TBDD=TADD*A(PSL(K)+K-1)
        RHO=RHO+TADD*TBDD
        ISTRT=KPB+1
        ISTOP=PSL(K+1)-1
        IF (ISTOP.LT.ISTRT) GO TO 40
        WN12(K)=ISTRT
        I=SL(K)+(KPB-PSL(K))+1
        ISUB=SL(N+1+I)
        WN11(K)=WN11(ISUB)
        WN11(ISUB)=K
        DO 50 II=ISTRT,ISTOP
          ISUB=SL(N+1+I)
          RN01(ISUB)=RN01(ISUB)+A(II+K)*TBDD
          I=I+1
   50   CONTINUE
        GO TO 40
   60   SIG=A(PSL(J)+J-1)-RHO
        IF (ALF.GT.SIG) THEN
          ALF=SIG
          L=J
        END IF
        GAM=0.0D0
        ISTRT=PSL(J)
        ISTOP=PSL(J+1)-1
        IF (ISTOP.LT.ISTRT) GO TO 90
        WN12(J)=ISTRT
        I=SL(J)
        ISUB=SL(N+1+I)
        WN11(J)=WN11(ISUB)
        WN11(ISUB)=J
        DO 70 II=ISTRT,ISTOP
          ISUB=SL(N+1+I)
          A(II+J)=(A(II+J)-RN01(ISUB))
          RN01(ISUB)=0.0D0
          I=I+1
   70   CONTINUE
        DO 80 K=PSL(J)+J,PSL(J+1)+J-1
          GAM=MAX(GAM,ABS(A(K)))
   80   CONTINUE
        GAM=GAM*GAM
   90   RHO=MAX(ABS(SIG),GAM/BET,DEL)
        IF (TAU.LT.RHO-SIG) THEN
          TAU=RHO-SIG
          INF=-1
        END IF
!
!     GAUSSIAN ELIMINATION
!
        A(PSL(J)+J-1)=RHO
        DO 100 II=ISTRT,ISTOP
          A(II+J)=A(II+J)/RHO
  100   CONTINUE
  110 CONTINUE
      IF (L.NE.0.AND.ABS(ALF).GT.DEL) INF=L
      RETURN
      END
! SUBROUTINE MXSPCI                ALL SYSTEMS                89/12/01
! PURPOSE :
! SYMBOLIC FACTORIZATION OF A SPARSE SYMMETRIC MATRIX GIVEN IN THE
! NORMAL SCHEME PA,SA. ON OUTPUT WE HAVE POINTER VECTOR OF THE FACTOR
! PSL AND VECTOR OF COLUMN INDICES SL. ML IS THE NUMBER OF THE INDICES
! USED FOR THE VECTOR SL, WHERE WE HAVE FACTOR IN THE COMPACT FORM.
!
! PARAMETERS :
!  II  N ORDER OF THE MATRIX A.
!  IO  ML NUMBER OF THE NONZERO ELEMENTS IN THE FACTOR'S COMPACT SCHEME
!  II  MMAX  LENGTH OF THE ARRAY SL. IN THE CASE OF THE
!            INSUFFICIENT SPACE IT IS TO BE INCREASED.
!  II  PA(N+1) POINTER VECTOR OF THE INPUT MATRIX
!  II  SA(MMAX) VECTOR OF THE COLUMN INDICES OF THE INPUT MATRIX
!  IO  PSL(N+1) POINTER VECTOR OF THE FACTOR
!  RO  SL(MMAX) COMPACT SCHEME OF THE INDICES OF THE FACTOR
!  II  PERM(N) PERMUTATION VECTOR
!  II  INVP(N) INVERSE PERMUTATION VECTOR
!  IA  WN11(N+1) WORK VECTOR OF THE LENGTH N+1
!  IA  WN12(N+1) WORK VECTOR OF THE LENGTH N+1
!  IA  WN13(N+1) WORK VECTOR OF THE LENGTH N+1
!  IO  ISPACE AN INFORMATION ON SPACE OBTAINED DURING THE PROCESS
!       OF THE FACTORIZATION.
!      ISPACE=0    THE FACTORIZATION HAS TERMINATED NORMALLY
!      ISPACE=1    INSUFFICIENT SPACE AVAILABLE
!
! METHOD :
! S.C.EISENSTAT,M.C.GURSKY,M.H.SCHULTZ,A.H.SHERMAN:YALE SPARSE MATRIX
! PACKAGE I. THE SYMMETRIC CODES,ACM TRANS. ON MATH. SOFTWARE.
!
! NOTE: TYPE OF SL CHANGED FOR THE UFO APPLICATION.
!
      SUBROUTINE MXSPCI (N, ML, MMAX, PA, SA, PSL, SL, PERM, INVP, WN11,
     & WN12, WN13, ISPACE)
      INTEGER N,MMAX,PA(*),SA(*),PSL(*)
      INTEGER PERM(*),INVP(*),WN11(*),WN12(*),WN13(*)
      INTEGER ISPACE,I,INZ,J,JSTOP,JSTRT,K,KNZ,KXSUB,MRGK,LMAX,ML
      INTEGER NABOR,NODE,NP1,NZBEG,NZEND,RCHM,MRKFLG,M
      DOUBLE PRECISION SL(*)
      NZBEG=1
      NZEND=0
      PSL(1)=1
      DO 10 K=1,N
        WN11(K)=0
        WN13(K)=0
   10 CONTINUE
      NP1=N+1
      DO 160 K=1,N
        KNZ=0
        MRGK=WN11(K)
        MRKFLG=0
        WN13(K)=K
        IF (MRGK.NE.0) WN13(K)=WN13(MRGK)
        SL(K)=NZEND
        NODE=PERM(K)
        JSTRT=PA(NODE)
        JSTOP=PA(NODE+1)-1
        IF (JSTRT.GT.JSTOP) GO TO 160
        WN12(K)=NP1
        DO 30 J=JSTRT,JSTOP
          NABOR=SA(J)
          IF (NABOR.EQ.NODE) GO TO 30
          NABOR=INVP(NABOR)
          IF (NABOR.LE.K) GO TO 30
          RCHM=K
   20     M=RCHM
          RCHM=WN12(M)
          IF (RCHM.LE.NABOR) GO TO 20
          KNZ=KNZ+1
          WN12(M)=NABOR
          WN12(NABOR)=RCHM
          IF (WN13(NABOR).NE.WN13(K)) MRKFLG=1
   30   CONTINUE
        LMAX=0
        IF (MRKFLG.NE.0.OR.MRGK.EQ.0) GO TO 40
        IF (WN11(MRGK).NE.0) GO TO 40
        SL(K)=SL(MRGK)+1
        KNZ=PSL(MRGK+1)-(PSL(MRGK)+1)
        GO TO 150
   40   I=K
   50   I=WN11(I)
        IF (I.EQ.0) GO TO 90
        INZ=PSL(I+1)-(PSL(I)+1)
        JSTRT=SL(I)+1
        JSTOP=SL(I)+INZ
        IF (INZ.LE.LMAX) GO TO 60
        LMAX=INZ
        SL(K)=JSTRT
   60   RCHM=K
        DO 80 J=JSTRT,JSTOP
          NABOR=SL(N+1+J)
   70     M=RCHM
          RCHM=WN12(M)
          IF (RCHM.LT.NABOR) GO TO 70
          IF (RCHM.EQ.NABOR) GO TO 80
          KNZ=KNZ+1
          WN12(M)=NABOR
          WN12(NABOR)=RCHM
          RCHM=NABOR
   80   CONTINUE
        GO TO 50
   90   IF (KNZ.EQ.LMAX) GO TO 150
        IF (NZBEG.GT.NZEND) GO TO 130
        I=WN12(K)
        DO 100 JSTRT=NZBEG,NZEND
          IF (SL(N+1+JSTRT)-I.GE.0) THEN
            IF (SL(N+1+JSTRT).EQ.I) THEN
              GO TO 110
            ELSE
              GO TO 130
            END IF
          END IF
  100   CONTINUE
        GO TO 130
  110   SL(K)=JSTRT
        DO 120 J=JSTRT,NZEND
          IF (SL(N+1+J).NE.I) GO TO 130
          I=WN12(I)
          IF (I.GT.N) GO TO 150
  120   CONTINUE
        NZEND=JSTRT-1
  130   NZBEG=NZEND+1
        NZEND=NZEND+KNZ
!
!     A VARIANT IS USED WHEN CALLED SO THAT SL(X)=A(NB+X)
!
        IF (NZEND.GE.MMAX-N-1) GO TO 170
        I=K
        DO 140 J=NZBEG,NZEND
          I=WN12(I)
          SL(N+1+J)=I
          WN13(I)=K
  140   CONTINUE
        SL(K)=NZBEG
        WN13(K)=K
  150   IF (KNZ.GT.1) THEN
          KXSUB=SL(K)
          I=SL(N+1+KXSUB)
          WN11(K)=WN11(I)
          WN11(I)=K
        END IF
        PSL(K+1)=PSL(K)+KNZ
  160 CONTINUE
      SL(N)=SL(N)+1
      SL(N+1)=SL(N)
      ML=N+SL(N+1)
      ISPACE=0
      RETURN
  170 ISPACE=1
      RETURN
      END
! SUBROUTINE MXSPCM                ALL SYSTEMS                92/12/01
! PURPOSE :
! MULTIPLICATION OF A GIVEN VECTOR X BY A SPARSE SYMMETRIC POSITIVE
! DEFINITE MATRIX A+E USING THE FACTORIZATION A+E=L*D*TRANS(L) OBTAINED
! BY THE SUBROUTINE MXSPGN. FACTORS ARE STORED IN THE COMPACT FORM.
!
! PARAMETERS :
!  II  N ORDER OF THE MATRIX A.
!  RI  A(MMAX)      FACTORIZATION A+E=L*D*TRANS(L) OBTAINED BY THE
!         SUBROUTINE MXSPGN.IT CONTAINS THE NUMERICAL VALUES OF THE
!         FACTORS STORED IN THE COMPACT FORM ACCORDING TO THE
!         INFORMATION IN THE VECTORS PSL,SL.
!  II  PSL(N+1) POINTER ARRAY OF THE FACTORIZED SPARSE MATRIX
!  II  SL(MMAX) INDICES OF THE COMPACT SCHEME OF THE FACTORS.
!  RU  X(N)  ON INPUT THE GIVEN VECTOR, ON OUTPUT THE RESULT
!         OF MULTIPLICATION.
!  RA  RN01(N) AUXILIARY VECTOR.
!  II  JOB  OPTION. IF JOB=0 THEN X:=(A+E)*X. IF JOB>0 THEN
!         X:=TRANS(L)*X. IF JOB<0 THEN X:=L*X.
!
      SUBROUTINE MXSPCM (N, A, PSL, SL, X, RN01, JOB)
      INTEGER N
      INTEGER PSL(*),SL(*),JOB
      DOUBLE PRECISION A(*),X(*),RN01(*),ZERO
      PARAMETER  (ZERO=0.0D0)
      INTEGER I,J,IS
      DO 10 I=1,N
        RN01(I)=ZERO
   10 CONTINUE
!
!     FIRST PHASE:X=TRANS(L)*X
!
      IF (JOB.GE.0) THEN
        DO 30 I=1,N
          IS=SL(I)+N+1
          DO 20 J=PSL(I)+I,PSL(I+1)+I-1
            X(I)=X(I)+A(J)*X(SL(IS))
            IS=IS+1
   20     CONTINUE
   30   CONTINUE
      END IF
!
!     SECOND PHASE:X=D*X
!
      IF (JOB.EQ.0) THEN
        DO 40 I=1,N
          X(I)=X(I)*A(PSL(I)+I-1)
   40   CONTINUE
      END IF
!
!     THIRD PHASE:X=L*X
!
      IF (JOB.LE.0) THEN
        DO 60 I=N,1,-1
          IS=SL(I)+N+1
          DO 50 J=PSL(I)+I,PSL(I+1)+I-1
            RN01(SL(IS))=RN01(SL(IS))+A(J)*X(I)
            IS=IS+1
   50     CONTINUE
   60   CONTINUE
        DO 70 I=1,N
          X(I)=RN01(I)+X(I)
   70   CONTINUE
      END IF
      RETURN
      END
! SUBROUTINE MXSPCN                ALL SYSTEMS               93/12/01
! PURPOSE :
!  ESTIMATION OF THE MINIMUM EIGENVALUE AND THE CORRESPONDING EIGENVECTO
!  OF A SPARSE SYMMETRIC POSITIVE DEFINITE MATRIX A+E USING THE
!  FACTORIZATION A+E=L*D*TRANS(L) OBTAINED BY THE SUBROUTINE MXSPCF.
!
! PARAMETERS :
!  II  N ORDER OF THE MATRIX A.
!  RI  A(MMAX)  FACTORS L,D OF THE FACTORIZATION A+E=L*D*TRANS(L)
!                STORED USING THE COMPACT SCHEME OF STORING.
!  II  PSL(N+1) POINTER ARRAY OF THE FACTORIZED SPARSE MATRIX
!  II  SL(MMAX)  ARRAY OF COLUMN INDICES OF THE FACTORS L AND D
!         STORED USING THE COMPACT SCHEME.
!         SUBROUTINE MXDPGF.
!  RO  X(N)  ESTIMATED EIGENVECTOR.
!  RO  ALF  ESTIMATED EIGENVALUE.
!  II  JOB  OPTION. IF JOB=0 THEN ONLY ESTIMATED EIGENVALUE IS
!         COMPUTED. IS JOB>0 THEN BOTH ESTIMATED EIGENVALUE AND
!         ESTIMATED EIGENVECTOR ARE COMPUTED.
!
      SUBROUTINE MXSPCN (N, A, PSL, SL, X, ALF, JOB)
      INTEGER N
      DOUBLE PRECISION A(*),X(*),ALF
      INTEGER PSL(*),SL(*),JOB
      DOUBLE PRECISION XP,XM,FP,FM,MXVDOT
      INTEGER I,K,IS
      DOUBLE PRECISION ZERO,ONE
      PARAMETER  (ZERO=0.0D0,ONE=1.0D0)
!
!     COMPUTATION OF THE VECTOR V WITH POSSIBLE MAXIMUM NORM SUCH
!     THAT  L*D**(1/2)*V=U  WHERE U HAS ELEMENTS +1 OR -1
!
      DO 10 I=1,N
        X(I)=ZERO
   10 CONTINUE
      DO 50 K=1,N
        XP=-X(K)+ONE
        XM=-X(K)-ONE
        FP=ABS(XP)
        FM=ABS(XM)
        IS=SL(K)+N+1
        DO 20 I=PSL(K)+K,PSL(K+1)+K-1
          FP=FP+ABS(X(SL(IS))+A(I)*XP)
          FM=FM+ABS(X(SL(IS))+A(I)*XM)
          IS=IS+1
   20   CONTINUE
        IF (FP.GE.FM) THEN
          X(K)=XP
          IS=SL(K)+N+1
          DO 30 I=PSL(K)+K,PSL(K+1)+K-1
            X(SL(IS))=X(SL(IS))+A(I)*XP
            IS=IS+1
   30     CONTINUE
        ELSE
          X(K)=XM
          IS=SL(K)+N+1
          DO 40 I=PSL(K)+K,PSL(K+1)+K-1
            X(SL(IS))=X(SL(IS))+A(I)*XM
            IS=IS+1
   40     CONTINUE
        END IF
   50 CONTINUE
!
!     COMPUTATION OF THE VECTOR X SUCH THAT
!     D**(1/2)*TRANS(L)*X=V
!
      FM=ZERO
      DO 60 K=1,N
        IF (JOB.LE.0) THEN
          FP=SQRT(A(PSL(K)+K-1))
          X(K)=X(K)/FP
          FM=FM+X(K)*X(K)
        ELSE
          X(K)=X(K)/A(PSL(K)+K-1)
        END IF
   60 CONTINUE
      FP=DBLE(N)
      IF (JOB.LE.0) THEN
!
!     FIRST ESTIMATION OF THE MINIMUM EIGENVALUE BY THE FORMULA
!     ALF=(TRANS(U)*U)/(TRANS(V)*V)
!
        ALF=FP/FM
        RETURN
      END IF
      FM=ZERO
      DO 80 K=N,1,-1
        IS=SL(K)+N+1
        DO 70 I=PSL(K)+K,PSL(K+1)+K-1
          X(K)=X(K)-A(I)*X(SL(IS))
          IS=IS+1
   70   CONTINUE
        FM=FM+X(K)*X(K)
   80 CONTINUE
      FM=SQRT(FM)
      IF (JOB.LE.1) THEN
!
!     SECOND ESTIMATION OF THE MINIMUM EIGENVALUE BY THE FORMULA
!     ALF=SQRT(TRANS(U)*U)/SQRT(TRANS(X)*X)
!
        ALF=SQRT(FP)/FM
      ELSE
!
!     INVERSE ITERATIONS
!
        DO 100 K=2,JOB
!
!     SCALING THE VECTOR X BY ITS NORM
!
          DO 90 I=1,N
            X(I)=X(I)/FM
   90     CONTINUE
          CALL MXSPCB (N, A, PSL, SL, X, 0)
          FM=SQRT(MXVDOT(N,X,X))
  100   CONTINUE
        ALF=ONE/FM
      END IF
!
!     SCALING THE VECTOR X BY ITS NORM
!
      DO 110 I=1,N
        X(I)=X(I)/FM
  110 CONTINUE
      RETURN
      END
! FUNCTION MXSPCP                  ALL SYSTEMS                92/12/01
! PURPOSE :
! COMPUTATION OF THE NUMBER MXSPCP=TRANS(X)*D**(-1)*X WHERE D IS A
! DIAGONAL MATRIX IN THE FACTORIZATION A+E=L*D*TRANS(L) OBTAINED BY THE
! SUBROUTINE MXSPGN. THE FACTORS ARE STORED IN THE COMPACT FORM.
!
! PARAMETERS :
!  II  N ORDER OF THE MATRIX A.
!  RI  A(MMAX)      FACTORIZATION A+E=L*D*TRANS(L) OBTAINED BY THE
!         SUBROUTINE MXSPGN.IT CONTAINS THE NUMERICAL VALUES OF THE
!         FACTORS STORED IN THE COMPACT FORM ACCORDING TO THE
!         INFORMATION IN THE VECTORS PSL,SL.
!  II  PSL(N+1)  POINTER VECTOR OF THE FACTORIZED MATRIX A.
!  RI  X(N)  INPUT VECTOR
!  RR  MXSPCP  COMPUTED NUMBER MXSPCP=TRANS(X)*D**(-1)*X
!
      FUNCTION MXSPCP (N, A, PSL, X)
      INTEGER N
      DOUBLE PRECISION A(*),X(*),MXSPCP
      DOUBLE PRECISION TEMP
      INTEGER PSL(*),I
      TEMP=0.0D0
      DO 10 I=1,N
        TEMP=TEMP+X(I)*X(I)/A(PSL(I)+I-1)
   10 CONTINUE
      MXSPCP=TEMP
      RETURN
      END
! FUNCTION MXSPCQ                  ALL SYSTEMS                92/12/01
! PURPOSE :
! COMPUTATION OF THE NUMBER MXSPCQ=TRANS(X)*D*X WHERE D IS A
! DIAGONAL MATRIX IN THE FACTORIZATION A+E=L*D*TRANS(L) OBTAINED BY THE
! SUBROUTINE MXSPGN. FACTORS ARE STORED IN THE COMPACT FORM.
!
! PARAMETERS :
!  II  N ORDER OF THE MATRIX A.
!  RI  A(MMAX)      FACTORIZATION A+E=L*D*TRANS(L) OBTAINED BY THE
!         SUBROUTINE MXSPGN.IT CONTAINS THE NUMERICAL VALUES OF THE
!         FACTORS STORED IN THE COMPACT FORM ACCORDING TO THE
!         INFORMATION IN THE VECTORS PSL,SL.
!  II  PSL(N+1)  POINTER VECTOR OF THE FACTORIZED MATRIX A
!  RI  X(N)  INPUT VECTOR
!  RR  MXSPCQ  COMPUTED NUMBER MXSPCQ=TRANS(X)*D*X
!
      FUNCTION MXSPCQ (N, A, PSL, X)
      INTEGER N
      DOUBLE PRECISION A(*),X(*),MXSPCQ
      DOUBLE PRECISION TEMP
      INTEGER PSL(N+1),I
      DOUBLE PRECISION ZERO
      PARAMETER  (ZERO=0.0D0)
      TEMP=ZERO
      DO 10 I=1,N
        TEMP=TEMP+X(I)*X(I)*A(PSL(I)+I-1)
   10 CONTINUE
      MXSPCQ=TEMP
      RETURN
      END
! SUBROUTINE MXSPCT                 ALL SYSTEMS                92/12/01
! PURPOSE :
! REWRITE SYMMETRIC MATRIX INTO THE PERMUTED FACTORIZED COMPACT SCHEME.
! MOIDIFIED VERSION FOR THE USE WITH MXSPCJ.
!
! PARAMETERS:
!  II  N  SIZE OF THE SYSTEM SOLVED.
!  II  NB NUMBER OF NONZEROS IN THE UPPER TRIANGLE OF THE ORIGINAL
!         MATRIX.
!  II  ML SIZE OF THE COMPACT FACTOR.
!  II  MMAX DECLARED LENGTH OF THE ARRAYS JA,A.
!  RU  A(MMAX) NUMERICAL VALUES OF THE SPARSE HESSIAN APPROXIMATION
!              STORED AT THE POSITIONS 1, ...,NB.
!  IU  JA(MMAX) INDICES OF THE NONZERO ELEMENTS OF THE HESSIAN MATRIX IN
!             THE PACKED ROW FORM AT THE FIRST NB POSITIONS.
!             NEW POSITIONS
!             IN THE PERMUTED FACTOR STORED IN A(NB+1), ..., A(2*NB),
!             INDICES OF COMPACT SCHEME IN A(2*NB+1), ..., A(2*NB+ML).
!  II  PSL(N+1)  POINTER VECTOR OF THE COMPACT FORM OF THE TRIANGULAR
!             FACTOR OF THE HESSIAN APPROXIMATION.
!  IO  ITERM  ERROR FLAG. IF ITERM < 0 - LACK OF SPACE IN JA.
!
!
      SUBROUTINE MXSPCT (N, NB, ML, MMAX, A, JA, PSL, ITERM)
      INTEGER N,NB,ML,MMAX,JA(*)
      INTEGER PSL(*),ITERM
      DOUBLE PRECISION A(*)
      INTEGER I,J
!
!     WN11 CONTAINS BEGINNINGS OF THE FACTOR ROWS
!
      ITERM=0
!
!     LACK OF SPACE
!
      IF (MMAX.LE.NB+PSL(N+1)+N-1) THEN
        ITERM=-43
        RETURN
      END IF
      IF (MMAX.LE.2*NB+ML) THEN
        ITERM=-44
        RETURN
      END IF
      DO 10 I=NB+1,NB+PSL(N+1)+N-1
        A(I)=0.0D0
   10 CONTINUE
      DO 20 I=NB+ML+1,2*NB+ML
        J=JA(I)
        A(NB+J)=A(I-NB-ML)
   20 CONTINUE
      RETURN
      END
! SUBROUTINE MXSPTB                ALL SYSTEMS                94/12/01
! PURPOSE :
! SOLUTION OF A SYSTEM OF LINEAR EQUATIONS WITH A SPARSE SYMMETRIC
! POSITIVE DEFINITE MATRIX A+E USING INCOMPLETE ILUT-TYPE FACTORIZATION
! A+E=L*D*TRANS(L) OBTAINED BY THE SUBROUTINE MXSPTF.
!
! PARAMETERS :
!  II  N ORDER OF THE MATRIX A.
!  RI  A(MMAX) INCOMPLETE FACTORIZATION A+E=L*D*TRANS(L) OBTAINED BY THE
!         SUBROUTINE MXSPTF.
!  II  IA(N+1)  POINTERS OF THE DIAGONAL ELEMENTS OF A.
!  II  JA(MMAX)  INDICES OF THE NONZERO ELEMENTS OF A.
!  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 MXSPTB (N, A, IA, JA, X, JOB)
      INTEGER N,IA(*),JA(*),JOB
      DOUBLE PRECISION A(*),X(*)
      INTEGER I,J,K
      DOUBLE PRECISION TEMP,SUM
!
!     FIRST PHASE
!
      IF (JOB.GE.0) THEN
        DO 20 I=1,N
          K=IA(I)
          IF (K.LE.0) GO TO 20
          TEMP=X(I)*A(K)
          DO 10 J=IA(I)+1,IA(I+1)-1
            K=JA(J)
            IF (K.GT.0) X(K)=X(K)-A(J)*TEMP
   10     CONTINUE
          IF (JOB.EQ.0) X(I)=TEMP
   20   CONTINUE
      END IF
!
!     THIRD PHASE
!
      IF (JOB.LE.0) THEN
        DO 40 I=N,1,-1
          K=IA(I)
          IF (K.LE.0) GO TO 40
          SUM=0.0D0
          TEMP=A(K)
          DO 30 J=IA(I)+1,IA(I+1)-1
            K=JA(J)
            IF (K.GT.0) SUM=SUM+A(J)*X(K)
   30     CONTINUE
          SUM=SUM*TEMP
          X(I)=X(I)-SUM
   40   CONTINUE
      END IF
      RETURN
      END
! SUBROUTINE MXSPTF                ALL SYSTEMS                03/12/01
! PURPOSE :
! INCOMPLETE CHOLESKY FACTORIZATION A+E=L*D*TRANS(L) OF A SPARSE
! SYMMETRIC POSITIVE DEFINITE MATRIX A+E WHERE D AND E ARE DIAGONAL
! POSITIVE DEFINITE MATRICES AND L IS A LOWER TRIANGULAR MATRIX.
! METHOD IS BASED ON THE SIMPLE IC(0) ALGORITHM WITHOUT DIAGONAL
! COMPENSATION. SPARSE RIGHT-LOOKING IMPLEMENTATION.
!
! PARAMETERS :
!  II  N ORDER OF THE MATRIX A.
!  RI  A(M)  SPARSE SYMMETRIC (USUALLY POSITIVE DEFINITE) MATRIX.
!  II  IA(N+1)  POINTERS OF THE DIAGONAL ELEMENTS OF A.
!  II  JA(M)  INDICES OF THE NONZERO ELEMENTS OF A.
!  IA  WN01(N+1)  AMXILIARY ARRAY.
!  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 MXSPTF (N, A, IA, JA, WN01, INF, ALF, TAU)
      INTEGER N,IA(*),JA(*),WN01(*),INF
      DOUBLE PRECISION A(*),ALF,TAU
      INTEGER I,J,K,L,II,LL,K1,L1,L2,JSTRT,JSTOP,IDIAG,KSTRT,KSTOP,NJA
      DOUBLE PRECISION PTOL,BET,GAM,TEMP,DEL,DIAG,NDIAG,INVDIAG
      PTOL=ALF
      NJA=IA(N+1)-1
!
!     INITIALIZE AMXILIARY VECTOR
!
      INF=0
      CALL MXVINS (N, 0, WN01)
!
!     GILL-MURRAY MODIFICATION
!
      ALF=0.0D0
      BET=0.0D0
      GAM=0.0D0
      TAU=0.0D0
      DO 20 I=1,N
        IDIAG=IA(I)
        IF (JA(IDIAG).LE.0) GO TO 20
        TEMP=A(IDIAG)
        BET=MAX(BET,ABS(TEMP))
        DO 10 J=IA(I)+1,IA(I+1)-1
          IF (JA(J).LE.0) GO TO 10
          TEMP=A(J)
          GAM=MAX(GAM,ABS(TEMP))
   10   CONTINUE
   20 CONTINUE
      BET=MAX(PTOL,BET,GAM/DBLE(N))
      DEL=PTOL*BET
!
!     COMPUTE THE PRECONDITIONER
!
      LL=0
      DO 80 K=1,N
        KSTRT=IA(K)
        KSTOP=IA(K+1)-1
        IF (JA(KSTRT).LE.0) GO TO 80
        DIAG=A(KSTRT)
        IF (ALF.GT.DIAG) THEN
          ALF=DIAG
          LL=K
        END IF
        GAM=0.0D0
        DO 30 J=KSTRT+1,KSTOP
          IF (JA(J).LE.0) GO TO 30
          TEMP=A(J)
          GAM=MAX(GAM,ABS(TEMP))
   30   CONTINUE
        GAM=GAM*GAM
        INVDIAG=MAX(ABS(DIAG),GAM/BET,DEL)
        IF (TAU.LT.INVDIAG-DIAG) THEN
          TAU=INVDIAG-DIAG
          INF=-1
        END IF
        INVDIAG=1.0D0/INVDIAG
        A(KSTRT)=INVDIAG
!
!     RIGHT-LOOKING UPDATE
!
!
!     SET POINTERS
!
        DO 40 II=KSTRT,KSTOP
          K1=JA(II)
          IF (K1.GT.0) WN01(K1)=II
   40   CONTINUE
!
!     INNER LOOP
!
        DO 60 I=KSTRT+1,KSTOP
          J=JA(I)
          IF (J.LE.0) GO TO 60
          NDIAG=A(I)
          JSTRT=IA(J)
          JSTOP=IA(J+1)-1
          DO 50 L=JSTRT,JSTOP
            L1=JA(L)
            IF (L1.LE.0) GO TO 50
            L2=WN01(L1)
            IF (L2.NE.0) THEN
              A(L)=A(L)-(A(L2)*INVDIAG)*NDIAG
            END IF
   50     CONTINUE
   60   CONTINUE
!
!     CLEAR THE POINTERS
!
        DO 70 II=KSTRT,KSTOP
          K1=JA(II)
          IF (K1.GT.0) WN01(K1)=0
   70   CONTINUE
   80 CONTINUE
      IF (LL.GT.0.AND.ABS(ALF).GT.DEL) INF=LL
      RETURN
      END
! SUBROUTINE MXSRMD               ALL SYSTEMS                92/12/01
! PURPOSE :
! MULTIPLICATION OF TRANSPOSE OF A DENSE RECTANGULAR MATRIX A BY
! A VECTOR X AND ADDITION OF A SCALED VECTOR ALF*Y.
!
! PARAMETERS :
!  II  N  NUMBER OF ROWS OF THE MATRIX A.
!  II  NA NUMBER OF COLUMNS OF THE MATRIX A.
!  II  MA  NUMBER OF ELEMENTS IN THE FIELD A.
!  RI  A(MA)  RECTANGULAR MATRIX STORED AS A TWO-DIMENSIONAL ARRAY.
!  II  IA(NA+1)  POSITION OF THE FIRST RORWS ELEMENTS IN THE FIELD A.
!  II  JA(MA) COLUMN INDICES OF ELEMENTS IN THE FIELD A.
!  RI  X(N)  INPUT VECTOR.
!  RI  ALF  SCALING FACTOR.
!  RI  Y(NA)  INPUT VECTOR.
!  RO  Z(NA)  OUTPUT VECTOR EQUAL TO TRANS(A)*X+ALF*Y.
!
      SUBROUTINE MXSRMD (NA, A, IA, JA, X, ALF, Y, Z)
      INTEGER NA,IA(*),JA(*)
      DOUBLE PRECISION A(*),X(*),ALF,Y(*),Z(*)
      DOUBLE PRECISION TEMP
      INTEGER I,J,K,L,JP
      DO 20 I=1,NA
        K=IA(I)
        L=IA(I+1)-K
        TEMP=ALF*Y(I)
        DO 10 J=1,L
          JP=JA(K)
          IF (JP.GT.0) TEMP=TEMP+A(K)*X(JP)
          K=K+1
   10   CONTINUE
        Z(I)=TEMP
   20 CONTINUE
      RETURN
      END
! SUBROUTINE MXSRMM               ALL SYSTEMS                92/12/01
! PURPOSE :
! MULTIPLICATION OF TRANSPOSE OF A DENSE RECTANGULAR MATRIX A BY
! A VECTOR X.
!
! PARAMETERS :
!  II  N  NUMBER OF ROWS OF THE MATRIX A.
!  II  NA NUMBER OF COLUMNS OF THE MATRIX A.
!  II  MA  NUMBER OF ELEMENTS IN THE FIELD A.
!  RI  A(MA)  RECTANGULAR MATRIX STORED AS A TWO-DIMENSIONAL ARRAY.
!  II  IA(NA+1)  POSITION OF THE FIRST RORWS ELEMENTS IN THE FIELD A.
!  II  JA(MA) COLUMN INDICES OF ELEMENTS IN THE FIELD A.
!  RI  X(N)  INPUT VECTOR.
!  RO  Y(M)  OUTPUT VECTOR EQUAL TO TRANS(A)*X.
!
      SUBROUTINE MXSRMM (NA, A, IA, JA, X, Y)
      INTEGER NA,IA(*),JA(*)
      DOUBLE PRECISION A(*),X(*),Y(*)
      DOUBLE PRECISION TEMP
      INTEGER I,J,K,L,JP
      DO 20 I=1,NA
        K=IA(I)
        L=IA(I+1)-K
        TEMP=0.0D0
        DO 10 J=1,L
          JP=JA(K)
          IF (JP.GT.0) TEMP=TEMP+A(K)*X(JP)
          K=K+1
   10   CONTINUE
        Y(I)=TEMP
   20 CONTINUE
      RETURN
      END
! SUBROUTINE  MXSRSP               ALL SYSTEMS               95/12/01
! PURPOSE : CREATE ROW PERMUTATIONS FOR OBTAINING DIAGONAL NONZEROS.
!
!  PARAMETERS :
!  II  N  NUMBER OF COLUMNS OF THE MATRIX.
!  II  M  NUMBER OF NONZEROS MEMBERS IN THE MATRIX.
!  II  IA(M+1)  ROW POINTERS OF THE SPARSE MATRIX.
!  II  JA(M)  COLUMN INDICES OF THE SPARSE MATRIX.
!  IO  IP(N)  PERMUTATION VECTOR.
!  II  NR  NUMBER OF STRUCTURALLY INDEPENDENT ROWS.
!  IA  IW1(N) AMXILIARY VECTOR.
!  IA  IW2(N) AMXILIARY VECTOR.
!  IA  IW3(N) AMXILIARY VECTOR.
!  IA  IW4(N) AMXILIARY VECTOR.
!
      SUBROUTINE MXSRSP (N, IA, JA, IP, NR, IW1, IW2, IW3, IW4)
      INTEGER N,NR
      INTEGER IA(*),IP(*),IW1(*),IW2(*),IW3(*),IW4(*),JA(*)
      INTEGER I,I1,I2,II,J,J1,K,KK,L
      DO 10 I=1,N
        IW2(I)=IA(I+1)-IA(I)-1
        IW3(I)=0
        IP(I)=0
   10 CONTINUE
      NR=0
!
!     MAIN LOOP.
!     EACH PASS ROUND THIS LOOP EITHER RESULTS IN A NEW ASSIGNMENT
!     OR GIVES A ROW WITH NO ASSIGNMENT.
!
      DO 100 L=1,N
        J=L
        IW1(J)=-1
        DO 70 K=1,L
!
!     LOOK FOR A CHEAP ASSIGNMENT
!
          I1=IW2(J)
          IF (I1.LT.0) GO TO 30
          I2=IA(J+1)-1
          I1=I2-I1
          DO 20 II=I1,I2
            I=JA(II)
            IF (IP(I).EQ.0) GO TO 80
   20     CONTINUE
!
!     NO CHEAP ASSIGNMENT IN ROW.
!
          IW2(J)=-1
!
!     BEGIN LOOKING FOR ASSIGNMENT CHAIN STARTING WITH ROW J.
!
   30     CONTINUE
          IW4(J)=IA(J+1)-IA(J)-1
!
!     INNER LOOP.  EXTENDS CHAIN BY ONE OR BACKTRACKS.
!
          DO 60 KK=1,L
            I1=IW4(J)
            IF (I1.LT.0) GO TO 50
            I2=IA(J+1)-1
            I1=I2-I1
!
!     FORWARD SCAN.
!
            DO 40 II=I1,I2
              I=JA(II)
              IF (IW3(I).EQ.L) GO TO 40
!
!     COLUMN I HAS NOT YET BEEN ACCESSED DURING THIS PASS.
!
              J1=J
              J=IP(I)
              IW3(I)=L
              IW1(J)=J1
              IW4(J1)=I2-II-1
              GO TO 70
   40       CONTINUE
!
!     BACKTRACKING STEP.
!
   50       CONTINUE
            J=IW1(J)
            IF (J.EQ.-1) GO TO 100
   60     CONTINUE
   70   CONTINUE
!
!     NEW ASSIGNMENT IS MADE.
!
   80   CONTINUE
        IP(I)=J
        IW2(J)=I2-II-1
        NR=NR+1
        DO 90 K=1,L
          J=IW1(J)
          IF (J.EQ.-1) GO TO 100
          II=IA(J+1)-IW4(J)-2
          I=JA(II)
          IP(I)=J
   90   CONTINUE
  100 CONTINUE
!
!     IF MATRIX IS STRUCTURALLY SINGULAR, WE NOW COMPLETE THE
!     PERMUTATION IP.
!
      IF (NR.EQ.N) RETURN
      DO 110 I=1,N
        IW2(I)=0
  110 CONTINUE
      K=0
      DO 130 I=1,N
        IF (IP(I).NE.0) GO TO 120
        K=K+1
        IW4(K)=I
        GO TO 130
  120   CONTINUE
        J=IP(I)
        IW2(J)=I
  130 CONTINUE
      K=0
      DO 140 I=1,N
        IF (IW2(I).NE.0) GO TO 140
        K=K+1
        L=IW4(K)
        IP(L)=I
  140 CONTINUE
      RETURN
      END
! SUBROUTINE MXSSDA                ALL SYSTEMS                91/12/01
! PURPOSE :
! A SPARSE 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.
!  RI  A(M) ELEMENTS OF THE SPARSE SYMMETRIC MATRIX STORED IN THE
!      PACKED FORM.
!  II  IA(N+1)  POINTERS OF THE DIAGONAL ELEMENTS OF A.
!  RI  ALF  SCALING FACTOR.
!
      SUBROUTINE MXSSDA (N, A, IA, ALF)
      INTEGER N,IA(*)
      DOUBLE PRECISION A(*),ALF
      INTEGER I
      DO 10 I=1,N
        A(IA(I))=A(IA(I))+ALF
   10 CONTINUE
      RETURN
      END
! FUNCTION MXSSDL                  ALL SYSTEMS                88/12/01
! PURPOSE :
! DETERMINATION OF A MINIMUM DIAGONAL ELEMENT OF A SPARSE SYMMETRIC
! MATRIX
!
! PARAMETERS :
!  II  N  ORDER OF THE MATRIX A
!  RI  A(MMAX) ELEMENTS OF THE SPARSE SYMMETRIC MATRIX STORED IN THE
!      USUAL FORM.
!  II  IA(N+1)  POINTER VECTOR OF THE DIAGONAL OF THE SPARSE MATRIX.
!  II  JA(MMAX)  INDICES OF NONZERO ELEMENTS OF THE SPARSE MATRIX.
!  IO  INF  INDEX OF INIMUM DIAGONAL ELEMENT OF THE MATRIX A.
!  RR  MXSSDL  MINIMUM DIAGONAL ELEMENT OF THE MATRIX A.
!
      FUNCTION MXSSDL (N, A, IA, JA, INF)
      INTEGER N,IA(*),JA(*),INF
      DOUBLE PRECISION A(*),MXSSDL
      DOUBLE PRECISION CON
      PARAMETER  (CON=1.0D60)
      INTEGER I,J
      INF=0
      MXSSDL=CON
      DO 10 I=1,N
        J=IA(I)
        IF (JA(J).GT.0.AND.MXSSDL.GT.A(J)) THEN
          INF=I
          MXSSDL=A(J)
        END IF
   10 CONTINUE
      RETURN
      END
! SUBROUTINE MXSSMD                ALL SYSTEMS                93/12/01
! PURPOSE :
! MULTIPLICATION OF A SPARSE SYMMETRIC MATRIX A BY A VECTOR X
! AND ADDITION OF A SCALED VECTOR ALF*Y.
!
! PARAMETERS :
!  II  N  ORDER OF THE MATRIX A.
!  RI  A(M) ELEMENTS OF THE SPARSE SYMMETRIC MATRIX STORED IN THE
!      PACKED FORM.
!  II  IA(N)  POINTERS OF THE DIAGONAL ELEMENTS OF A.
!  II  JA(M)  INDICES OF THE NONZERO ELEMENTS OF A.
!  RI  X(N)  INPUT VECTOR.
!  RI  ALF  SCALING FACTOR.
!  RI  Y(NA)  INPUT VECTOR.
!  RO  Z(NA)  OUTPUT VECTOR EQUAL TO A*X+ALF*Y.
!
      SUBROUTINE MXSSMD (N, A, IA, JA, X, ALF, Y, Z)
      INTEGER N,IA(*),JA(*)
      DOUBLE PRECISION A(*),X(*),ALF,Y(*),Z(*)
      INTEGER I,J,K,JSTRT,JSTOP
      DO 10 I=1,N
        Z(I)=ALF*Y(I)
   10 CONTINUE
      JSTOP=0
      DO 30 I=1,N
        JSTRT=JSTOP+1
        JSTOP=IA(I+1)-1
        IF (JA(JSTRT).GT.0) THEN
          DO 20 J=JSTRT,JSTOP
            K=JA(J)
            IF (J.EQ.JSTRT) THEN
              Z(I)=Z(I)+A(J)*X(I)
            ELSE IF (K.GT.0) THEN
              Z(K)=Z(K)+A(J)*X(I)
              Z(I)=Z(I)+A(J)*X(K)
            END IF
   20     CONTINUE
        END IF
   30 CONTINUE
      RETURN
      END
! SUBROUTINE MXSSMG                ALL SYSTEMS                91/12/01
! PURPOSE :
!  GERSHGORIN BOUNDS OF THE EIGENVALUAE OF A DENSE SYMMETRIC MATRIX.
!  AMIN .LE. ANY EIGENVALUE OF A .LE. AMAX.
!
! PARAMETERS :
!  II  N  DIMENSION OF THE MATRIX A.
!  RI  A(M) ELEMENTS OF THE SPARSE SYMMETRIC MATRIX STORED IN THE
!      PACKED FORM.
!  II  IA(N+1)  POINTERS OF THE DIAGONAL ELEMENTS OF A.
!  II  JA(M)  INDICES OF THE NONZERO ELEMENTS OF A.
!  RO  AMIN  LOWER BOUND OF THE EIGENVALUE OF A.
!  RO  AMAX  UPPER BOUND OF THE EIGENVALUE OF A.
!
      SUBROUTINE MXSSMG (N, A, IA, JA, AMIN, AMAX, X)
      INTEGER N,IA(*),JA(*)
      DOUBLE PRECISION A(*),AMIN,AMAX,X(*)
      INTEGER I,J,K,JSTRT,JSTOP
      DOUBLE PRECISION CMAX
      PARAMETER  (CMAX=1.0D60)
      DO 10 I=1,N
        X(I)=0.0D0
   10 CONTINUE
      JSTOP=0
      DO 30 I=1,N
        JSTRT=JSTOP+1
        JSTOP=IA(I+1)-1
        IF (JA(JSTRT).GT.0) THEN
          DO 20 K=JSTRT+1,JSTOP
            J=JA(K)
            IF (J.GT.0) THEN
              X(I)=X(I)+ABS(A(K))
              X(J)=X(J)+ABS(A(K))
            END IF
   20     CONTINUE
        END IF
   30 CONTINUE
      AMIN=CMAX
      AMAX=-CMAX
      DO 40 I=1,N
        K=IA(I)
        IF (K.GT.0) THEN
          AMAX=MAX(AMAX,A(K)+X(I))
          AMIN=MIN(AMIN,A(K)-X(I))
        END IF
   40 CONTINUE
      RETURN
      END
! SUBROUTINE MXSSMI                ALL SYSTEMS                92/12/01
! PURPOSE :
! SPARSE SYMMETRIC MATRIX A IS SET TO THE UNIT MATRIX WITH THE SAME
! ORDER.
!
! PARAMETERS :
!  II  N  ORDER OF THE MATRIX A.
!  RU  A(M) ELEMENTS OF THE SPARSE SYMMETRIC MATRIX STORED IN THE
!      PACKED FORM.
!  II  IA(N+1)  POINTERS OF THE DIAGONAL ELEMENTS OF A.
!  II  JA(M)  INDICES OF THE NONZERO ELEMENTS OF A.
!
      SUBROUTINE MXSSMI (N, A, IA)
      INTEGER N,IA(*)
      DOUBLE PRECISION A(*)
      INTEGER I,K
      DO 10 I=1,IA(N+1)-1
        A(I)=0.0D0
   10 CONTINUE
      DO 20 I=1,N
        K=ABS(IA(I))
        A(K)=1.0D0
   20 CONTINUE
      RETURN
      END
! SUBROUTINE MXSSMM                ALL SYSTEMS                92/12/01
! PURPOSE :
! MULTIPLICATION OF A SPARSE SYMMETRIC MATRIX BY A VECTOR X.
!
! PARAMETERS :
!  II  N  ORDER OF THE MATRIX A.
!  II  M  NUMBER OF NONZERO ELEMENTS OF THE MATRIX A.
!  RI  A(M) ELEMENTS OF THE SPARSE SYMMETRIC MATRIX STORED IN THE
!      PACKED FORM.
!  II  IA(N+1)  POINTERS OF THE DIAGONAL ELEMENTS OF A.
!  II  JA(M)  INDICES OF THE NONZERO ELEMENTS OF A.
!  RI  X(N)  INPUT VECTOR.
!  RO  Y(N)  OUTPUT VECTOR WHERE Y := A * X.
!
      SUBROUTINE MXSSMM (N, A, IA, JA, X, Y)
      INTEGER N,IA(*),JA(*)
      DOUBLE PRECISION A(*),X(*),Y(*)
      INTEGER I,J,K,JSTRT,JSTOP
      DO 10 I=1,N
        Y(I)=0.0D0
   10 CONTINUE
      JSTOP=0
      DO 30 I=1,N
        JSTRT=JSTOP+1
        JSTOP=IA(I+1)-1
        IF (JA(JSTRT).GT.0) THEN
          DO 20 J=JSTRT,JSTOP
            K=JA(J)
            IF (J.EQ.JSTRT) THEN
              Y(I)=Y(I)+A(J)*X(I)
            ELSE IF (K.GT.0) THEN
              Y(K)=Y(K)+A(J)*X(I)
              Y(I)=Y(I)+A(J)*X(K)
            END IF
   20     CONTINUE
        END IF
   30 CONTINUE
      RETURN
      END
! SUBROUTINE MXSSMN                ALL SYSTEMS                89/12/01
! PURPOSE :
! THIS SUBROUTINE FINDS THE PERMUTATION VECTOR PERM FOR THE
! SPARSE SYMMETRIC MATRIX GIVEN IN THE VECTOR PAIR PA,SA.IT USES
! THE SO-CALLED NESTED DISSECTION METHOD.
!
! PARAMETERS :
!  II  N ORDER OF THE MATRIX A.
!  II  MMAX  LENGTH OF THE PRINCIPAL MATRIX VECTORS.
!  II  PA(N+1) POINTER VECTOR OF THE INPUT MATRIX.
!  II  SA(MMAX) VECTOR OF THE COLUMN INDICES OF THE INPUT MATRIX.
!  IO  PERM(N) PERMUTATION VECTOR.
!  IA  WN11(N+1) AMXILIARY VECTOR.
!  IA  WN12(N+1) AMXILIARY VECTOR.
!  IA  WN13(N+1) AMXILIARY VECTOR.
!
! METHOD :
! NESTED DISSECTION METHOD
!
      SUBROUTINE MXSSMN (N, PA, SA, PERM, WN11, WN12, WN13)
      INTEGER N
      INTEGER PA(*),SA(*),PERM(*)
      INTEGER WN11(*),WN12(*),WN13(*)
      INTEGER I,J,K,NUM,ROOT,NLVL,LVLEND,LBEGIN,ICS
      INTEGER NN,N1,MINDEG,N2,LVSIZE,NDEG,NUNLVL,MIDLVL
      INTEGER TEMP,NPUL,NSEP,I1,I2,I3,I4,J1,J2
      DO 10 I=1,N
        WN11(I)=1
   10 CONTINUE
      NUM=0
      DO 230 I=1,N
   20   IF (WN11(I).EQ.0) GO TO 230
        ROOT=I
        WN11(ROOT)=0
        WN13(1)=ROOT
        NLVL=0
        LVLEND=0
        ICS=1
   30   LBEGIN=LVLEND+1
        LVLEND=ICS
        NLVL=NLVL+1
        WN12(NLVL)=LBEGIN
        DO 50 K=LBEGIN,LVLEND
          NN=WN13(K)
          DO 40 J=PA(NN),PA(NN+1)-1
            N2=SA(J)
            IF (N2.EQ.NN) GO TO 40
            IF (WN11(N2).EQ.0) GO TO 40
            ICS=ICS+1
            WN13(ICS)=N2
            WN11(N2)=0
   40     CONTINUE
   50   CONTINUE
        LVSIZE=ICS-LVLEND
        IF (LVSIZE.GT.0) GO TO 30
        WN12(NLVL+1)=LVLEND+1
        DO 60 K=1,ICS
          NN=WN13(K)
          WN11(NN)=1
   60   CONTINUE
        ICS=WN12(NLVL+1)-1
        IF (NLVL.EQ.1.OR.NLVL.EQ.ICS) GO TO 150
   70   J1=WN12(NLVL)
        MINDEG=ICS
        ROOT=WN13(J1)
        IF (ICS.EQ.J1) GO TO 100
        DO 90 J=J1,ICS
          NN=WN13(J)
          NDEG=0
          DO 80 K=PA(NN),PA(NN+1)-1
            N1=SA(K)
            IF (N1.EQ.NN) GO TO 80
            IF (WN11(N1).GT.0) NDEG=NDEG+1
   80     CONTINUE
          IF (NDEG.GE.MINDEG) GO TO 90
          ROOT=NN
          MINDEG=NDEG
   90   CONTINUE
  100   CONTINUE
        WN11(ROOT)=0
        WN13(1)=ROOT
        NUNLVL=0
        LVLEND=0
        ICS=1
  110   LBEGIN=LVLEND+1
        LVLEND=ICS
        NUNLVL=NUNLVL+1
        WN12(NUNLVL)=LBEGIN
        DO 130 K=LBEGIN,LVLEND
          NN=WN13(K)
          DO 120 J=PA(NN),PA(NN+1)-1
            N2=SA(J)
            IF (N2.EQ.NN) GO TO 120
            IF (WN11(N2).EQ.0) GO TO 120
            ICS=ICS+1
            WN13(ICS)=N2
            WN11(N2)=0
  120     CONTINUE
  130   CONTINUE
        LVSIZE=ICS-LVLEND
        IF (LVSIZE.GT.0) GO TO 110
        WN12(NUNLVL+1)=LVLEND+1
        DO 140 K=1,ICS
          NN=WN13(K)
          WN11(NN)=1
  140   CONTINUE
        IF (NUNLVL.LE.NLVL) GO TO 150
        NLVL=NUNLVL
        IF (NLVL.LT.ICS) GO TO 70
  150   CONTINUE
        IF (NLVL.GE.3) GO TO 170
        NSEP=WN12(NLVL+1)-1
        DO 160 K=1,NSEP
          NN=WN13(K)
          PERM(NUM+K)=NN
          WN11(NN)=0
  160   CONTINUE
        GO TO 220
  170   MIDLVL=(NLVL+2)/2
        I3=WN12(MIDLVL)
        I1=WN12(MIDLVL+1)
        I4=I1-1
        I2=WN12(MIDLVL+2)-1
        DO 180 K=I1,I2
          NN=WN13(K)
          PA(NN)=-PA(NN)
  180   CONTINUE
        NSEP=0
        DO 200 K=I3,I4
          NN=WN13(K)
          J1=PA(NN)
          J2=IABS(PA(NN+1))-1
          DO 190 J=J1,J2
            N2=SA(J)
            IF (N2.EQ.NN) GO TO 190
            IF (PA(N2).GT.0) GO TO 190
            NSEP=NSEP+1
            PERM(NSEP+NUM)=NN
            WN11(NN)=0
            GO TO 200
  190     CONTINUE
  200   CONTINUE
        DO 210 K=I1,I2
          NN=WN13(K)
          PA(NN)=-PA(NN)
  210   CONTINUE
  220   CONTINUE
        NUM=NUM+NSEP
        IF (NUM.GE.N) GO TO 240
        GO TO 20
  230 CONTINUE
  240 CONTINUE
      IF (N.LT.2) GO TO 260
      NPUL=N/2
      DO 250 I=1,NPUL
        TEMP=PERM(I)
        PERM(I)=PERM(N-I+1)
        PERM(N-I+1)=TEMP
  250 CONTINUE
  260 CONTINUE
      RETURN
      END
! FUNCTION MXSSMQ                  ALL SYSTEMS                92/12/01
! PURPOSE :
! VALUE OF A QUADRATIC FORM WITH A SPARSE SYMMETRIC MATRIX A.
!
! PARAMETERS :
!  II  N  ORDER OF THE MATRIX A.
!  RI  A(M) ELEMENTS OF THE SPARSE SYMMETRIC MATRIX STORED IN THE
!      PACKED FORM.
!  II  IA(N+1)  POINTERS OF THE DIAGONAL ELEMENTS OF A.
!  II  JA(M)  INDICES OF THE NONZERO ELEMENTS OF A.
!  RI  X(N)  INPUT VECTOR.
!  RI  Y(N)  INPUT VECTOR.
!  RR  MXSSMQ  VALUE OF THE QUADRATIC FORM MXSSMQ=TRANS(Y)*A*X.
!
      FUNCTION MXSSMQ (N, A, IA, JA, X, Y)
      INTEGER N,IA(*),JA(*)
      DOUBLE PRECISION A(*),X(*),Y(*),MXSSMQ
      DOUBLE PRECISION TEMP1,TEMP2
      INTEGER I,J,K,JSTRT,JSTOP
      JSTOP=0
      TEMP1=0.0D0
      DO 20 I=1,N
        JSTRT=JSTOP+1
        JSTOP=IA(I+1)-1
        IF (JA(JSTRT).GT.0) THEN
          TEMP2=0.0D0
          DO 10 J=JSTRT,JSTOP
            K=JA(J)
            IF (J.EQ.JSTRT) THEN
              TEMP2=TEMP2+A(J)*Y(I)
            ELSE IF (K.GT.0) THEN
              TEMP2=TEMP2+2*Y(K)*A(J)
            END IF
   10     CONTINUE
          TEMP1=TEMP1+X(I)*TEMP2
        END IF
   20 CONTINUE
      MXSSMQ=TEMP1
      RETURN
      END
! SUBROUTINE MXSSMY                ALL SYSTEMS                93/12/01
! PURPOSE :
! CORRECTION OF A SPARSE SYMMETRIC MATRIX A. THE CORRECTION IS DEFINED
! AS A:=A+SUM OF (HALF*(X*TRANS(Y)+Y*TRANS(X)))(I)/SIGMA(I) WHERE
! SIGMA(I) IS A DOT PRODUCT TRANS(X)*X WHERE ONLY CONTRIBUTIONS
! CORRESPONDING TO NONZEROS IN ROW I ARE SUMMED UP, X AND Y ARE GIVEN
! VECTORS.
!
! PARAMETERS :
!  II  N  ORDER OF THE MATRIX A.
!  RI  A(M) ELEMENTS OF THE SPARSE SYMMETRIC MATRIX STORED IN THE
!      PACKED FORM.
!  II  IA(N)  POINTERS OF THE DIAGONAL ELEMENTS OF A.
!  II  JA(M)  INDICES OF THE NONZERO ELEMENTS OF A.
!  RA  XS(N) AMXILIARY VECTOR - USED FOR SIGMA(I).
!  RI  X(N)  VECTOR IN THE CORRECTION TERM.
!  RI  Y(N)  VECTOR IN THE CORRECTION TERM.
!
      SUBROUTINE MXSSMY (N, A, IA, JA, XS, X, Y)
      INTEGER N,IA(*),JA(*)
      DOUBLE PRECISION A(*),X(*),Y(*),XS(*),SIGMA,TEMP
      INTEGER I,J,K,JSTRT,JSTOP
      CALL MXVSET (N, 0.0D0, XS)
!
!      COMPUTE SIGMA(I)
!
      JSTOP=0
      DO 20 I=1,N
        JSTRT=JSTOP+1
        JSTOP=IA(I+1)-1
        IF (JA(JSTRT).GT.0) THEN
          SIGMA=0.0D0
          DO 10 J=JSTRT,JSTOP
            K=JA(J)
            IF (K.GT.0) THEN
              SIGMA=SIGMA+Y(K)*Y(K)
              IF (K.NE.I) XS(K)=XS(K)+Y(I)*Y(I)
            END IF
   10     CONTINUE
          XS(I)=XS(I)+SIGMA
        END IF
   20 CONTINUE
!
!      UPDATE MATRIX
!
      JSTOP=0
      DO 40 I=1,N
        JSTRT=JSTOP+1
        JSTOP=IA(I+1)-1
        IF (JA(JSTRT).GT.0) THEN
          IF (XS(I).EQ.0.0D0) THEN
            TEMP=0.0D0
          ELSE
            TEMP=X(I)/XS(I)
          END IF
          DO 30 J=JSTRT,JSTOP
            K=JA(J)
            IF (K.GT.0) THEN
              IF (XS(K).EQ.0.0D0) THEN
                A(J)=A(J)+0.5D0*TEMP*Y(K)
              ELSE
                A(J)=A(J)+0.5D0*(TEMP*Y(K)+Y(I)*X(K)/XS(K))
              END IF
            END IF
   30     CONTINUE
        END IF
   40 CONTINUE
      RETURN
      END
! SUBROUTINE MXSTG1                ALL SYSTEMS                89/12/01
! PURPOSE :
! WIDTHENING THE PACKED FORM OF THE VECTORS IA, JA OF THE SPARSE MATRIX
!
! PARAMETERS :
!  II  N ORDER OF THE SPARSE MATRIX.
!  IU  M NUMBER OF NONZERO ELEMENTS IN THE MATRIX.
!  II  MMAX LENGTH OF THE ARRAY JA.
!  II  IA(N+1) POINTER VECTOR OF THE INPUT MATRIX.
!  II  JA(MMAX) VECTOR OF THE COLUMN INDICES OF THE INPUT MATRIX.
!  IA  PD(N+1) AMXILIARY VECTOR.
!  IA  WN11(N+1) AMXILIARY VECTOR.
!
      SUBROUTINE MXSTG1 (N, M, IA, JA, PD, WN11)
      INTEGER N,M
      INTEGER IA(*),PD(*),JA(*),WN11(*)
      INTEGER I,J,L1,L,K
!
!     UPPER TRIANGULAR INFORMATION TO THE AMXILIARY ARRAY
!
      L1=IA(1)
      DO 10 I=1,N
        L=L1
        L1=IA(I+1)
        WN11(I)=L1-L
   10 CONTINUE
!
!     LOWER TRIANGULAR INFORMATION TO THE AMXILIARY ARRAY
!
      DO 30 I=1,N
        DO 20 J=IA(I)+1,IA(I+1)-1
          K=ABS(JA(J))
          WN11(K)=WN11(K)+1
   20   CONTINUE
   30 CONTINUE
!
!     BY PARTIAL SUMMING WE GET POINTERS OF THE WIDE STRUCTURE
!     WN11(I) POINTS AT THE END OF THE ROW I
!
      L=0
      DO 40 I=2,N
        WN11(I)=WN11(I)+WN11(I-1)
   40 CONTINUE
!
!     DEFINE LENGTH OF THE WITHENED STRUCTURE
!
      M=WN11(N)
!
!     SHIFT OF UPPER TRIANGULAR ROWS
!
      PD(1)=1
      DO 60 I=N,1,-1
        L=WN11(I)
        PD(I+1)=L+1
        DO 50 J=IA(I+1)-1,IA(I),-1
          JA(L)=JA(J)
          L=L-1
   50   CONTINUE
   60 CONTINUE
!
!     FORMING OF THE LOWER TRIANGULAR PART
!
      DO 80 I=1,N
        DO 70 J=WN11(I)+IA(I)+2-IA(I+1),WN11(I)
          K=ABS(JA(J))
          JA(PD(K))=I
          PD(K)=PD(K)+1
   70   CONTINUE
   80 CONTINUE
      DO 90 I=1,N
        IA(I+1)=WN11(I)+1
   90 CONTINUE
      RETURN
      END
! SUBROUTINE MXSTL1                ALL SYSTEMS                91/12/01
! PURPOSE :
! PACKING OF THE WIDTHENED FORM OF THE VECTORS IA, JA OF THE SPARSE
! MATRIX
!
! PARAMETERS :
!  II  N ORDER OF THE SPARSE MATRIX.
!  IU  M NUMBER OF NONZERO ELEMENTS IN THE MATRIX.
!  II  MMAX LENGTH OF THE ARRAY JA.
!  IU  IA(N+1) POINTER VECTOR OF THE INPUT MATRIX.
!  IU  JA(MMAX) VECTOR OF THE COLUMN INDICES OF THE INPUT MATRIX.
!  IA  PD(N+1) AMXILIARY VECTOR.
!
      SUBROUTINE MXSTL1 (N, M, IA, JA, PD)
      INTEGER N,M
      INTEGER IA(*),PD(*),JA(*)
      INTEGER I,J,L,JSTRT,JSTOP
      L=1
!
!     PD DEFINITION
!
      JSTOP=0
      DO 20 I=1,N
        JSTRT=JSTOP+1
        JSTOP=IA(I+1)-1
        DO 10 J=JSTRT,JSTOP
          IF (ABS(JA(J)).EQ.I) THEN
            PD(I)=J
            GO TO 20
          END IF
   10   CONTINUE
   20 CONTINUE
!
!     REWRITE THE STRUCTURE
!
      DO 40 I=1,N
        DO 30 J=PD(I),IA(I+1)-1
          JA(L)=JA(J)
          L=L+1
   30   CONTINUE
        IA(I+1)=L
   40 CONTINUE
      IA(1)=1
!
!     SET THE LENGTH OF THE PACKED STRUCTURE
!
      M=L-1
      RETURN
      END
! SUBROUTINE MXSTL2                ALL SYSTEMS                90/12/01
! PURPOSE :
! PACKING OF THE WIDTHENED FORM OF THE VECTORS A,IA,JA OF THE SPARSE
! MATRIX
!
! PARAMETERS :
!  II  N ORDER OF THE SPARSE MATRIX.
!  IU  M NUMBER OF NONZERO ELEMENTS IN THE MATRIX.
!  II  MMAX LENGTH OF THE ARRAY JA.
!  RU  A(MMAX) VECTOR OF NUMERICAL VALUES OF THE MATRIX BEING SHRINKED.
!  IU  IA(N+1) POINTER VECTOR OF THE INPUT MATRIX.
!  IU  JA(MMAX) VECTOR OF THE COLUMN INDICES OF THE INPUT MATRIX.
!  IA  PD(N+1) AMXILIARY VECTOR.
!
      SUBROUTINE MXSTL2 (N, M, A, IA, JA, PD)
      INTEGER N,M
      INTEGER IA(*),PD(*),JA(*)
      DOUBLE PRECISION A(*)
      INTEGER I,J,L,JSTRT,JSTOP
      L=1
!
!     PD DEFINITION
!
      JSTOP=0
      DO 20 I=1,N
        JSTRT=JSTOP+1
        JSTOP=IA(I+1)-1
        DO 10 J=JSTRT,JSTOP
          IF (ABS(JA(J)).EQ.I) THEN
            PD(I)=J
            GO TO 20
          END IF
   10   CONTINUE
   20 CONTINUE
!
!     REWRITE THE STRUCTURE
!
      DO 40 I=1,N
        DO 30 J=PD(I),IA(I+1)-1
          JA(L)=JA(J)
          A(L)=A(J)
          L=L+1
   30   CONTINUE
        IA(I+1)=L
   40 CONTINUE
      IA(1)=1
!
!     SET THE LENGTH OF THE PACKED STRUCTURE
!
      M=L-1
      RETURN
      END
! SUBROUTINE MXTPGB                ALL SYSTEMS                93/12/01
! PURPOSE :
! BACK SUBSTITUTION FOR A DECOMPOSED TRIDIAGONAL MATRIX.
!
! PARAMETERS :
!  II  N  ORDER OF THE TRIDIAGONAL MATRIX T.
!  RI  D(N)  ELEMENTS OF THE DIAGONAL MATRIX D IN THE DECOMPOSITION
!         T=L*D*TRANS(L).
!  RI  E(N)  SUBDIAGONAL ELEMENTS OF THE LOWER TRIANGULAR MATRIX L IN
!         THE DECOMPOSITION T=L*D*TRANS(L).
!  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:=T**(-1)*X. IF JOB>0 THEN
!         X:=L**(-1)*X. IF JOB<0 THEN X:=TRANS(L)**(-1)*X.
!
      SUBROUTINE MXTPGB (N, D, E, X, JOB)
      INTEGER N,JOB
      DOUBLE PRECISION D(*),E(*),X(*)
      INTEGER I
      IF (JOB.GE.0) THEN
!
!     PHASE 1 : X:=L**(-1)*X
!
        DO 10 I=2,N
          X(I)=X(I)-X(I-1)*E(I-1)
   10   CONTINUE
      END IF
      IF (JOB.EQ.0) THEN
!
!     PHASE 2 : X:=D**(-1)*X
!
        DO 20 I=1,N
          X(I)=X(I)/D(I)
   20   CONTINUE
      END IF
      IF (JOB.LE.0) THEN
!
!     PHASE 3 : X:=TRANS(L)**(-1)*X
!
        DO 30 I=N-1,1,-1
          X(I)=X(I)-X(I+1)*E(I)
   30   CONTINUE
      END IF
      RETURN
      END
! SUBROUTINE MXTPGF                ALL SYSTEMS                03/12/01
! PURPOSE :
! CHOLESKI DECOMPOSITION OF A TRIDIAGONAL MATRIX.
!
! PARAMETERS :
!  II  N  ORDER OF THE TRIDIAGONAL MATRIX T.
!  RU  D(N)  ON INPUT DIAGONAL ELEMENTS OF THE TRIDIAGONAL MATRIX T.
!         ON OUTPUT ELEMENTS OF THE DIAGONAL MATRIX D IN THE
!         DECOMPOSITION T=L*D*TRANS(L).
!  RU  E(N)  ON INPUT SUBDIAGONAL ELEMENTS OF THE TRIDIAGONAL MATRIX T.
!         ON OUTPUT SUBDIAGONAL ELEMENTS OF THE LOWER TRIANGULAR MATRIX
!         IN THE DECOMPOSITION T=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.
!
      SUBROUTINE MXTPGF (N, D, E, INF, ALF, TAU)
      INTEGER N,INF
      DOUBLE PRECISION D(*),E(*),ALF,TAU
      DOUBLE PRECISION DI,EI,BET,GAM,DEL,TOL
      INTEGER I,L
      DOUBLE PRECISION ZERO,ONE,TWO
      PARAMETER  (ZERO=0.0D0,ONE=1.0D0,TWO=2.0D0)
      L=0
      INF=0
      TOL=ALF
!
!     ESTIMATION OF THE MATRIX NORM
!
      ALF=ZERO
      GAM=ZERO
      TAU=ZERO
      BET=ABS(D(1))
      DO 10 I=1,N-1
        BET=MAX(BET,ABS(D(I+1)))
        GAM=MAX(GAM,ABS(E(I)))
   10 CONTINUE
      BET=MAX(TOL,TWO*BET,GAM/MAX(ONE,DBLE(N-1)))
      DEL=TOL*MAX(BET,ONE)
      DO 20 I=1,N
        EI=D(I)
        IF (ALF.GT.EI) THEN
          ALF=EI
          L=I
        END IF
        GAM=ZERO
        IF (I.LT.N) GAM=E(I)**2
        DI=MAX(ABS(EI),GAM/BET,DEL)
        IF (TAU.LT.DI-EI) THEN
          TAU=DI-EI
          INF=-1
        END IF
!
!     GAUSSIAN ELIMINATION
!
        D(I)=DI
        IF (I.LT.N) THEN
          EI=E(I)
          E(I)=EI/DI
          D(I+1)=D(I+1)-E(I)*EI
        END IF
   20 CONTINUE
      IF (L.GT.0.AND.ABS(ALF).GT.DEL) INF=L
      RETURN
      END
! SUBROUTINE MXUCOP                ALL SYSTEMS                99/12/01
! PURPOSE :
! COPY OF THE VECTOR WITH INITIATION OF THE ACTIVE PART.
!
! PARAMETERS :
!  II  N  VECTOR DIMENSION.
!  RI  X(N)  INPUT VECTOR.
!  RO  Y(N)  OUTPUT VECTOR WHERE Y:= X.
!  II  IX(N)  VECTOR CONTAINING TYPES OF BOUNDS.
!  II  JOB  OPTION. IF JOB.GT.0 THEN INDEX I IS NOT USED WHENEVER
!         IX(I).LE.-1. IF JOB.LT.0 THEN INDEX I IS NOT USED WHENEVER
!         IX(I).EQ.-5.
!
      SUBROUTINE MXUCOP (N, X, Y, IX, JOB)
      INTEGER N,IX(*),JOB
      DOUBLE PRECISION X(*),Y(*)
      INTEGER I
      IF (JOB.EQ.0) THEN
        DO 10 I=1,N
          Y(I)=X(I)
   10   CONTINUE
      ELSE IF (JOB.GT.0) THEN
        DO 20 I=1,N
          IF (IX(I).GE.0) THEN
            Y(I)=X(I)
          ELSE
            Y(I)=0.0D0
          END IF
   20   CONTINUE
      ELSE
        DO 30 I=1,N
          IF (IX(I).NE.-5) THEN
            Y(I)=X(I)
          ELSE
            Y(I)=0.0D0
          END IF
   30   CONTINUE
      END IF
      RETURN
      END
! FUNCTION MXUDEL                  ALL SYSTEMS                99/12/01
! PURPOSE :
!  SQUARED NORM OF A SHIFTED VECTOR IN A BOUND CONSTRAINED CASE.
!
! PARAMETERS :
!  II  N  VECTOR DIMENSION.
!  RI  A  SCALING FACTOR.
!  RI  X(N)  INPUT VECTOR.
!  RI  Y(N)  INPUT VECTOR.
!  II  IX(N)  VECTOR CONTAINING TYPES OF BOUNDS.
!  II  JOB  OPTION. IF JOB.GT.0 THEN INDEX I IS NOT USED WHENEVER
!         IX(I).LE.-1. IF JOB.LT.0 THEN INDEX I IS NOT USED WHENEVER
!         IX(I).EQ.-5.
!  RR  MXUDEL SQUARED NORM OF Y+A*X.
!
      FUNCTION MXUDEL (N, A, X, Y, IX, JOB)
      INTEGER N,IX(N),JOB
      DOUBLE PRECISION A,X(N),Y(N),MXUDEL
      INTEGER I
      DOUBLE PRECISION TEMP
      TEMP=0.0D0
      IF (JOB.EQ.0) THEN
        DO 10 I=1,N
          TEMP=TEMP+(Y(I)+A*X(I))**2
   10   CONTINUE
      ELSE IF (JOB.GT.0) THEN
        DO 20 I=1,N
          IF (IX(I).GE.0) TEMP=TEMP+(Y(I)+A*X(I))**2
   20   CONTINUE
      ELSE
        DO 30 I=1,N
          IF (IX(I).NE.-5) TEMP=TEMP+(Y(I)+A*X(I))**2
   30   CONTINUE
      END IF
      MXUDEL=TEMP
      RETURN
      END
! SUBROUTINE MXUDIF                ALL SYSTEMS                99/12/01
! PURPOSE :
! VECTOR DIFFERENCE IN A BOUND CONSTRAINED CASE.
!
! PARAMETERS :
!  II  N  VECTOR DIMENSION.
!  RI  X(N)  INPUT VECTOR.
!  RI  Y(N)  INPUT VECTOR.
!  RO  Z(N)  OUTPUT VECTOR WHERE Z:= X - Y.
!  II  IX(N)  VECTOR CONTAINING TYPES OF BOUNDS.
!  II  JOB  OPTION. IF JOB.GT.0 THEN INDEX I IS NOT USED WHENEVER
!         IX(I).LE.-1. IF JOB.LT.0 THEN INDEX I IS NOT USED WHENEVER
!         IX(I).EQ.-5.
!
      SUBROUTINE MXUDIF (N, X, Y, Z, IX, JOB)
      INTEGER N,IX(N),JOB
      DOUBLE PRECISION X(*),Y(*),Z(*)
      INTEGER I
      IF (JOB.EQ.0) THEN
        DO 10 I=1,N
          Z(I)=X(I)-Y(I)
   10   CONTINUE
      ELSE IF (JOB.GT.0) THEN
        DO 20 I=1,N
          IF (IX(I).GE.0) Z(I)=X(I)-Y(I)
   20   CONTINUE
      ELSE
        DO 30 I=1,N
          IF (IX(I).NE.-5) Z(I)=X(I)-Y(I)
   30   CONTINUE
      END IF
      RETURN
      END
! SUBROUTINE MXUDIR                ALL SYSTEMS                99/12/01
! PURPOSE :
! VECTOR AUGMENTED BY THE SCALED VECTOR IN A BOUND CONSTRAINED CASE.
!
! 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.
!  II  IX(N)  VECTOR CONTAINING TYPES OF BOUNDS.
!  II  JOB  OPTION. IF JOB.GT.0 THEN INDEX I IS NOT USED WHENEVER
!         IX(I).LE.-1. IF JOB.LT.0 THEN INDEX I IS NOT USED WHENEVER
!         IX(I).EQ.-5.
!
      SUBROUTINE MXUDIR (N, A, X, Y, Z, IX, JOB)
      INTEGER N,IX(*),JOB
      DOUBLE PRECISION A,X(*),Y(*),Z(*)
      INTEGER I
      IF (JOB.EQ.0) THEN
        DO 10 I=1,N
          Z(I)=Y(I)+A*X(I)
   10   CONTINUE
      ELSE IF (JOB.GT.0) THEN
        DO 20 I=1,N
          IF (IX(I).GE.0) Z(I)=Y(I)+A*X(I)
   20   CONTINUE
      ELSE
        DO 30 I=1,N
          IF (IX(I).NE.-5) Z(I)=Y(I)+A*X(I)
   30   CONTINUE
      END IF
      RETURN
      END
! FUNCTION MXUDOT                  ALL SYSTEMS                99/12/01
! PURPOSE :
! DOT PRODUCT OF VECTORS IN A BOUND CONSTRAINED CASE.
!
! PARAMETERS :
!  II  N  VECTOR DIMENSION.
!  RI  X(N)  INPUT VECTOR.
!  RI  Y(N)  INPUT VECTOR.
!  II  IX(N)  VECTOR CONTAINING TYPES OF BOUNDS.
!  II  JOB  OPTION. IF JOB.GT.0 THEN INDEX I IS NOT USED WHENEVER
!         IX(I).LE.-1. IF JOB.LT.0 THEN INDEX I IS NOT USED WHENEVER
!         IX(I).EQ.-5.
!  RR  MXUDOT  VALUE OF DOT PRODUCT MXUDOT=TRANS(X)*Y.
!
      FUNCTION MXUDOT (N, X, Y, IX, JOB)
      INTEGER N,IX(*),JOB
      DOUBLE PRECISION X(*),Y(*),MXUDOT
      DOUBLE PRECISION TEMP
      INTEGER I
      DOUBLE PRECISION ZERO
      PARAMETER  (ZERO=0.0D0)
      TEMP=ZERO
      IF (JOB.EQ.0) THEN
        DO 10 I=1,N
          TEMP=TEMP+X(I)*Y(I)
   10   CONTINUE
      ELSE IF (JOB.GT.0) THEN
        DO 20 I=1,N
          IF (IX(I).GE.0) TEMP=TEMP+X(I)*Y(I)
   20   CONTINUE
      ELSE
        DO 30 I=1,N
          IF (IX(I).NE.-5) TEMP=TEMP+X(I)*Y(I)
   30   CONTINUE
      END IF
      MXUDOT=TEMP
      RETURN
      END
! SUBROUTINE MXUNEG                ALL SYSTEMS                00/12/01
! PURPOSE :
! COPY OF THE VECTOR WITH INITIATION OF THE ACTIVE PART.
!
! PARAMETERS :
!  II  N  VECTOR DIMENSION.
!  RI  X(N)  INPUT VECTOR.
!  RO  Y(N)  OUTPUT VECTOR WHERE Y:= X.
!  II  IX(N)  VECTOR CONTAINING TYPES OF BOUNDS.
!  II  JOB  OPTION. IF JOB.GT.0 THEN INDEX I IS NOT USED WHENEVER
!         IX(I).LE.-1. IF JOB.LT.0 THEN INDEX I IS NOT USED WHENEVER
!         IX(I).EQ.-5.
!
      SUBROUTINE MXUNEG (N, X, Y, IX, JOB)
      INTEGER N,IX(*),JOB
      DOUBLE PRECISION X(*),Y(*)
      INTEGER I
      IF (JOB.EQ.0) THEN
        DO 10 I=1,N
          Y(I)=-X(I)
   10   CONTINUE
      ELSE IF (JOB.GT.0) THEN
        DO 20 I=1,N
          IF (IX(I).GE.0) THEN
            Y(I)=-X(I)
          ELSE
            Y(I)=0.0D0
          END IF
   20   CONTINUE
      ELSE
        DO 30 I=1,N
          IF (IX(I).NE.-5) THEN
            Y(I)=-X(I)
          ELSE
            Y(I)=0.0D0
          END IF
   30   CONTINUE
      END IF
      RETURN
      END
! FUNCTION  MXUNOR               ALL SYSTEMS                99/12/01
! PURPOSE :
! EUCLIDEAN NORM OF A VECTOR IN A BOUND CONSTRAINED CASE.
!
! PARAMETERS :
!  II  N  VECTOR DIMENSION.
!  RI  X(N)  INPUT VECTOR.
!  II  IX(N)  VECTOR CONTAINING TYPES OF BOUNDS.
!  II  JOB  OPTION. IF JOB.GT.0 THEN INDEX I IS NOT USED WHENEVER
!         IX(I).LE.-1. IF JOB.LT.0 THEN INDEX I IS NOT USED WHENEVER
!         IX(I).EQ.-5.
!  RR  MXUNOR  EUCLIDEAN NORM OF X.
!
      FUNCTION MXUNOR (N, X, IX, JOB)
      INTEGER N,IX(*),JOB
      DOUBLE PRECISION X(*),MXUNOR
      DOUBLE PRECISION POM,DEN
      INTEGER I
      DOUBLE PRECISION ZERO
      PARAMETER  (ZERO=0.0D0)
      DEN=ZERO
      IF (JOB.EQ.0) THEN
        DO 10 I=1,N
          DEN=MAX(DEN,ABS(X(I)))
   10   CONTINUE
      ELSE IF (JOB.GT.0) THEN
        DO 20 I=1,N
          IF (IX(I).GE.0) DEN=MAX(DEN,ABS(X(I)))
   20   CONTINUE
      ELSE
        DO 30 I=1,N
          IF (IX(I).NE.-5) DEN=MAX(DEN,ABS(X(I)))
   30   CONTINUE
      END IF
      POM=ZERO
      IF (DEN.GT.ZERO) THEN
        IF (JOB.EQ.0) THEN
          DO 40 I=1,N
            POM=POM+(X(I)/DEN)**2
   40     CONTINUE
        ELSE IF (JOB.GT.0) THEN
          DO 50 I=1,N
            IF (IX(I).GE.0) POM=POM+(X(I)/DEN)**2
   50     CONTINUE
        ELSE
          DO 60 I=1,N
            IF (IX(I).NE.-5) POM=POM+(X(I)/DEN)**2
   60     CONTINUE
        END IF
      END IF
      MXUNOR=DEN*SQRT(POM)
      RETURN
      END
! SUBROUTINE MXUZER                ALL SYSTEMS                99/12/01
! PURPOSE :
! VECTOR ELEMENTS CORRESPONDING TO ACTIVE BOUNDS ARE SET TO ZERO.
!
! PARAMETERS :
!  II  N  VECTOR DIMENSION.
!  RO  X(N)  OUTPUT VECTOR SUCH THAT X(I)=A FOR ALL I.
!  II  IX(N)  VECTOR CONTAINING TYPES OF BOUNDS.
!  II  JOB  OPTION. IF JOB.GT.0 THEN INDEX I IS NOT USED WHENEVER
!         IX(I).LE.-1. IF JOB.LT.0 THEN INDEX I IS NOT USED WHENEVER
!         IX(I).EQ.-5.
!
      SUBROUTINE MXUZER (N, X, IX, JOB)
      INTEGER N,IX(*),JOB
      DOUBLE PRECISION X(*)
      INTEGER I
      IF (JOB.EQ.0) RETURN
      DO 10 I=1,N
        IF (IX(I).LT.0) X(I)=0.0D0
   10 CONTINUE
      RETURN
      END
! SUBROUTINE MXVCOP                ALL SYSTEMS                88/12/01
! 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)
      INTEGER N
      DOUBLE PRECISION X(*),Y(*)
      INTEGER I
      DO 10 I=1,N
        Y(I)=X(I)
   10 CONTINUE
      RETURN
      END
! SUBROUTINE MXVCOR                ALL SYSTEMS                93/12/01
! PURPOSE :
! CORRECTION OF A VECTOR.
!
! PARAMETERS :
!  II  N  VECTOR DIMENSION.
!  RI  A  CORRECTION FACTOR.
!  RU  X(N)  CORRECTED VECTOR. ZERO ELEMENTS OF X ARE SET TO BE EQUAL A.
!
      SUBROUTINE MXVCOR (N, A, X)
      INTEGER N
      DOUBLE PRECISION A,X(*)
      DOUBLE PRECISION ZERO
      PARAMETER  (ZERO=0.0D0)
      INTEGER I
      DO 10 I=1,N
        IF (X(I).EQ.ZERO) X(I)=A
   10 CONTINUE
      RETURN
      END
! SUBROUTINE MXVDIF                ALL SYSTEMS                88/12/01
! 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)
      INTEGER N
      DOUBLE PRECISION X(*),Y(*),Z(*)
      INTEGER I
      DO 10 I=1,N
        Z(I)=X(I)-Y(I)
   10 CONTINUE
      RETURN
      END
! SUBROUTINE MXVDIR                ALL SYSTEMS                91/12/01
! 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)
      DOUBLE PRECISION A
      INTEGER N
      DOUBLE PRECISION X(*),Y(*),Z(*)
      INTEGER I
      DO 10 I=1,N
        Z(I)=Y(I)+A*X(I)
   10 CONTINUE
      RETURN
      END
! FUNCTION MXVDOT                  ALL SYSTEMS                91/12/01
! 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.
!
      FUNCTION MXVDOT (N, X, Y)
      INTEGER N
      DOUBLE PRECISION X(*),Y(*),MXVDOT
      DOUBLE PRECISION TEMP
      INTEGER I
      TEMP=0.0D0
      DO 10 I=1,N
        TEMP=TEMP+X(I)*Y(I)
   10 CONTINUE
      MXVDOT=TEMP
      RETURN
      END
! SUBROUTINE MXVICP             ALL SYSTEMS                   93/12/01
! PURPOSE :
! COPYING OF AN INTEGER VECTOR.
!
! PARAMETERS :
!  II  N DIMENSION OF THE INTEGER VECTOR.
!  II  IX(N)  INPUT INTEGER VECTOR.
!  IO  IY(N)  OUTPUT INTEGER VECTOR SUCH THAT IY(I):= IX(I) FOR ALL I.
!
      SUBROUTINE MXVICP (N, IX, IY)
      INTEGER N,IX(*),IY(*)
      INTEGER I
      DO 10 I=1,N
        IY(I)=IX(I)
   10 CONTINUE
      RETURN
      END
! SUBROUTINE MXVINB            ALL SYSTEMS                   91/12/01
! PURPOSE :
! UPDATE OF AN INTEGER VECTOR.
!
! PARAMETERS :
!  II  N DIMENSION OF THE INTEGER VECTOR.
!  II  M DIMENSION OF THE CHANGED INTEGER VECTOR.
!  II  IX(N)  INTEGER VECTOR.
!  IU  JA(M)  INTEGER VECTOR WHICH IS UPDATED SO THAT JA(I)=-JA(I)
!         IF IX(JA(I)).LT.0.
!
      SUBROUTINE MXVINB (M, IX, JA)
      INTEGER M,IX(*),JA(*)
      INTEGER I
      DO 10 I=1,M
        JA(I)=ABS(JA(I))
        IF (IX(JA(I)).LT.0) JA(I)=-JA(I)
   10 CONTINUE
      RETURN
      END
! SUBROUTINE MXVINE             ALL SYSTEMS                   94/12/01
! 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 MXVINE (N, IX)
      INTEGER N,IX(*)
      INTEGER I
      DO 10 I=1,N
        IX(I)=ABS(IX(I))
   10 CONTINUE
      RETURN
      END
! SUBROUTINE MXVINI             ALL SYSTEMS                   99/12/01
! PURPOSE :
! ELEMENTS CORRESPONDING TO FIXED VARIABLES ARE SET TO -5.
!
! 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 MXVINI (N, IX)
      INTEGER N,IX(*)
      INTEGER I
      DO 10 I=1,N
        IF (ABS(IX(I)).EQ.5) IX(I)=-5
   10 CONTINUE
      RETURN
      END
! SUBROUTINE MXVINP             ALL SYSTEMS                   91/12/01
! PURPOSE :
! INITIATION OF A INTEGER PERMUTATION VECTOR.
!
! PARAMETERS :
!  II  N DIMENSION OF THE INTEGER VECTOR.
!  IO  IP(N)  INTEGER VECTOR SUCH THAT IP(I)=I FOR ALL I.
!
      SUBROUTINE MXVINP (N, IP)
      INTEGER N
      INTEGER IP(*)
      INTEGER I
      DO 10 I=1,N
        IP(I)=I
   10 CONTINUE
      RETURN
      END
! SUBROUTINE MXVINS             ALL SYSTEMS                   90/12/01
! 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)
      INTEGER IP,N
      INTEGER IX(*)
      INTEGER I
      DO 10 I=1,N
        IX(I)=IP
   10 CONTINUE
      RETURN
      END
! SUBROUTINE MXVLIN                ALL SYSTEMS                92/12/01
! 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)
      INTEGER N
      DOUBLE PRECISION A,X(*),B,Y(*),Z(*)
      INTEGER I
      DO 10 I=1,N
        Z(I)=A*X(I)+B*Y(I)
   10 CONTINUE
      RETURN
      END
! FUNCTION MXVMAX             ALL SYSTEMS                   91/12/01
! 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.
!
      FUNCTION MXVMAX (N, X)
      INTEGER N
      DOUBLE PRECISION X(*),MXVMAX
      INTEGER I
      DOUBLE PRECISION ZERO
      PARAMETER  (ZERO=0.0D0)
      MXVMAX=ZERO
      DO 10 I=1,N
        MXVMAX=MAX(MXVMAX,ABS(X(I)))
   10 CONTINUE
      RETURN
      END
! FUNCTION MXVMX1               ALL SYSTEMS                   91/12/01
! PURPOSE :
! L-INFINITY NORM OF A VECTOR WITH INDEX DETERMINATION.
!
! PARAMETERS :
!  II  N  VECTOR DIMENSION.
!  RI  X(N)  INPUT VECTOR.
!  IO  K  INDEX OF ELEMENT WITH MAXIMUM ABSOLUTE VALUE.
!  RR  MXVMX1  L-INFINITY NORM OF THE VECTOR X.
!
      FUNCTION MXVMX1 (N, X, K)
      INTEGER K,N
      DOUBLE PRECISION X(*),MXVMX1
      INTEGER I
      K=1
      MXVMX1=ABS(X(1))
      DO 10 I=2,N
        IF (ABS(X(I)).GT.MXVMX1) THEN
          K=I
          MXVMX1=ABS(X(I))
        END IF
   10 CONTINUE
      RETURN
      END
! SUBROUTINE MXVMUL             ALL SYSTEMS                   89/12/01
! 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)
      INTEGER K,N
      DOUBLE PRECISION D(*),X(*),Y(*)
      INTEGER I
      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
! 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)
      INTEGER N
      DOUBLE PRECISION X(*),Y(*)
      INTEGER I
      DO 10 I=1,N
        Y(I)=-X(I)
   10 CONTINUE
      RETURN
      END
! FUNCTION  MXVNOR               ALL SYSTEMS                91/12/01
! 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)
      INTEGER N
      DOUBLE PRECISION X(*),MXVNOR
      DOUBLE PRECISION DEN,POM
      INTEGER I
      DOUBLE PRECISION ZERO
      PARAMETER  (ZERO=0.0D0)
      DEN=ZERO
      DO 10 I=1,N
        DEN=MAX(DEN,ABS(X(I)))
   10 CONTINUE
      POM=ZERO
      IF (DEN.GT.ZERO) THEN
        DO 20 I=1,N
          POM=POM+(X(I)/DEN)**2
   20   CONTINUE
      END IF
      MXVNOR=DEN*SQRT(POM)
      RETURN
      END
! SUBROUTINE MXVSAB             ALL SYSTEMS                   91/12/01
! 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)
      INTEGER N
      DOUBLE PRECISION X(N),MXVSAB
      INTEGER I
      DOUBLE PRECISION ZERO
      PARAMETER  (ZERO=0.0D0)
      MXVSAB=ZERO
      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)
      INTEGER N
      DOUBLE PRECISION X(*),Y(*)
      DOUBLE PRECISION TEMP
      INTEGER I
      DO 10 I=1,N
        TEMP=Y(I)
        Y(I)=X(I)-Y(I)
        X(I)=TEMP
   10 CONTINUE
      RETURN
      END
! SUBROUTINE MXVSBP                ALL SYSTEMS                91/12/01
! PURPOSE :
! VECTOR X(N) IS PERMUTED ACCORDING TO THE FORMULA
! X(PERM(I)):=X(I).
!
! PARAMETERS :
!  II  N  LENGTH OF VECTORS.
!  II  PERM(N)  INPUT PERMUTATION VECTOR.
!  RU  X(N)  VECTOR THAT IS TO BE PERMUTED.
!  RA  RN01(N)  AMXILIARY VECTOR.
!
      SUBROUTINE MXVSBP (N, PERM, X, RN01)
      INTEGER N,PERM(*),I
      DOUBLE PRECISION RN01(*),X(*)
      DO 10 I=1,N
        RN01(PERM(I))=X(I)
   10 CONTINUE
      DO 20 I=1,N
        X(I)=RN01(I)
   20 CONTINUE
      RETURN
      END
! SUBROUTINE MXVSCL                ALL SYSTEMS                88/12/01
! 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)
      INTEGER N
      DOUBLE PRECISION A,X(*),Y(*)
      INTEGER I
      DO 10 I=1,N
        Y(I)=A*X(I)
   10 CONTINUE
      RETURN
      END
! SUBROUTINE MXVSET                ALL SYSTEMS                88/12/01
! 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)
      DOUBLE PRECISION A
      INTEGER N
      DOUBLE PRECISION X(*)
      INTEGER I
      DO 10 I=1,N
        X(I)=A
   10 CONTINUE
      RETURN
      END
! SUBROUTINE MXVSFP                ALL SYSTEMS                91/12/01
! PURPOSE :
! VECTOR X(N) IS PERMUTED ACCORDING TO THE FORMULA
! X(I)=X(PERM(I)).
!
! PARAMETERS :
!  II  N  LENGTH OF VECTORS.
!  II  PERM(N)  INPUT PERMUTATION VECTOR.
!  RU  X(N)  VECTOR THAT IS TO BE PERMUTED.
!  RA  RN01(N)  AMXILIARY VECTOR.
!
      SUBROUTINE MXVSFP (N, PERM, X, RN01)
      INTEGER N,PERM(*),I
      DOUBLE PRECISION RN01(*),X(*)
!
      DO 10 I=1,N
        RN01(I)=X(PERM(I))
   10 CONTINUE
      DO 20 I=1,N
        X(I)=RN01(I)
   20 CONTINUE
      RETURN
      END
! SUBROUTINE MXVSIP                ALL SYSTEMS                91/12/01
! PURPOSE :
! THE VECTOR OF THE INVERSE PERMUTATION IS COMPUTED.
!
! PARAMETERS :
!  II  N  LENGTH OF VECTORS.
!  II  PERM(N)  INPUT PERMUTATION VECTOR.
!  IO  INVP(N)  INVERSE PERMUTATION VECTOR.
!
      SUBROUTINE MXVSIP (N, PERM, INVP)
      INTEGER N,PERM(*),INVP(*)
      INTEGER I,J
      DO 10 I=1,N
        J=PERM(I)
        INVP(J)=I
   10 CONTINUE
      RETURN
      END
! SUBROUTINE MXVSR2                ALL SYSTEMS                92/12/01
! PURPOSE :
! RADIXSORT.
!
! PARAMETERS :
!  II  MCOLS  NUMBER OF INTEGER VALUES OF THE SORTED ARRAY.
!  RI  DEG(MCOLS)  VALUES OF THE SORTED ARRAY.
!  RO  ORD(MCOLS)  SORTED OUTPUT.
!  RA  RADIX(MCOLS+1)  AUXILIARY ARRAY.
!  II  WN01(MCOLS)  INDICES OF THE SORTED ARRAY.
!  II  LENGTH   NUMBER OF SORTED PIECES.
!
      SUBROUTINE MXVSR2 (MCOLS, DEG, ORD, RADIX, WN01, LENGTH)
      INTEGER MCOLS,WN01(*)
      DOUBLE PRECISION DEG(*),ORD(*),RADIX(*)
      INTEGER LENGTH,I,L,L1,L2
!
!     RADIX IS SHIFTED : 0-(MCOLS-1) --- 1-MCOLS
!
      DO 10 I=1,MCOLS+1
        RADIX(I)=0
   10 CONTINUE
      DO 20 I=1,LENGTH
        L2=WN01(I)
        L=DEG(L2)
        RADIX(L+1)=RADIX(L+1)+1
   20 CONTINUE
!
!     RADIX COUNTS THE NUMBER OF VERTICES WITH DEG(I)>=L
!
      L=0
      DO 30 I=MCOLS,0,-1
        L=RADIX(I+1)+L
        RADIX(I+1)=L
   30 CONTINUE
!
!     ARRAY ORD IS FILLED
!
      DO 40 I=1,LENGTH
        L2=WN01(I)
        L=DEG(L2)
        L1=RADIX(L+1)
        ORD(L1)=L2
        RADIX(L+1)=L1-1
   40 CONTINUE
      RETURN
      END
! SUBROUTINE MXVSR5                ALL SYSTEMS                92/12/01
! PURPOSE :
! SHELLSORT.
!
! PARAMETERS :
!  II  K  NUMBER OF INTEGER VALUES OF THE SORTED ARRAY.
!  II  L  CORRECTION FOR THE ABSOLUTE INDEX IN THE SORTED ARRAY
!  IU  ARRAY(K)  INTEGER SORTED ARRAY.
!  RO  ARRAYC(K)  REAL OUTPUT ARRAY.
!  RU  ARRAYD(K)  REAL ARRAY WHICH IS PERMUTED IN THE SAME WAY
!         AS THE INTEGER SORTED ARRAY.
!
      SUBROUTINE MXVSR5 (K, L, ARRAY, ARRAYC, ARRAYD)
      INTEGER K,L
      INTEGER ARRAY(*)
      DOUBLE PRECISION ARRAYC(*),ARRAYD(*)
      INTEGER IS,LA,LT,LS,LLS,I,J,JS,KHALF
      DOUBLE PRECISION LD
!
!     NOTHING TO BE SORTED
!
      IF (K.LE.1) GO TO 40
!
!     SHELLSORT
!
!     L - CORRECTION FOR THE ABSOLUTE INDEX IN THE SORTED ARRAY
!
      LS=131071
      KHALF=K/2
      DO 30 LT=1,17
        IF (LS.GT.KHALF) THEN
          LS=LS/2
          GO TO 30
        END IF
        LLS=K-LS
        DO 20 I=1,LLS
          IS=I+LS
          LA=ARRAY(IS)
          LD=ARRAYD(IS)
          J=I
          JS=IS
   10     IF (LA.GE.ARRAY(J)) THEN
            ARRAY(JS)=LA
            ARRAYD(JS)=LD
            ARRAYC(INT(LD))=JS+L
            GO TO 20
          ELSE
            ARRAY(JS)=ARRAY(J)
            ARRAYD(JS)=ARRAYD(J)
            ARRAYC(INT(ARRAYD(J)))=JS+L
            JS=J
            J=J-LS
          END IF
          IF (J.GE.1) GO TO 10
          ARRAY(JS)=LA
          ARRAYD(JS)=LD
          ARRAYC(INT(LD))=JS+L
   20   CONTINUE
        LS=LS/2
   30 CONTINUE
   40 CONTINUE
      RETURN
      END
! SUBROUTINE MXVSR7               ALL SYSTEMS                94/12/01
! PURPOSE :
! SHELLSORT
!
! PARAMETERS :
!  II  K LENGTH OF SORTED VECTOR.
!  IU  ARRAY(K) SORTED ARRAY.
!  IU  ARRAYB(K) SECOND SORTED ARRAY.
!
      SUBROUTINE MXVSR7 (K, ARRAY, ARRAYB)
      INTEGER K
      INTEGER ARRAY(*),ARRAYB(*)
      INTEGER IS,LA,LB,LT,LS,LLS,I,J,JS,KHALF
!
!     NOTHING TO BE SORTED
!
      IF (K.LE.1) GO TO 40
!
!     SHELLSORT
!
      LS=131071
      KHALF=K/2
      DO 30 LT=1,17
        IF (LS.GT.KHALF) THEN
          LS=LS/2
          GO TO 30
        END IF
        LLS=K-LS
        DO 20 I=1,LLS
          IS=I+LS
          LA=ARRAY(IS)
          LB=ARRAYB(IS)
          J=I
          JS=IS
   10     IF (LA.GE.ARRAY(J)) THEN
            ARRAY(JS)=LA
            ARRAYB(JS)=LB
            GO TO 20
          ELSE
            ARRAY(JS)=ARRAY(J)
            ARRAYB(JS)=ARRAYB(J)
            JS=J
            J=J-LS
          END IF
          IF (J.GE.1) GO TO 10
          ARRAY(JS)=LA
          ARRAYB(JS)=LB
   20   CONTINUE
        LS=LS/2
   30 CONTINUE
   40 CONTINUE
      RETURN
      END
! SUBROUTINE MXVSRT                ALL SYSTEMS                91/12/01
! PURPOSE :
! SHELLSORT
!
! PARAMETERS :
!  II  K LENGTH OF SORTED VECTOR.
!  IU  ARRAY(K) SORTED ARRAY.
!
      SUBROUTINE MXVSRT (K, ARRAY)
      INTEGER K
      INTEGER ARRAY(*)
      INTEGER IS,LA,LT,LS,LLS,I,J,JS,KHALF
!
!     NOTHING TO BE SORTED
!
      IF (K.LE.1) GO TO 40
!
!     SHELLSORT
!
      LS=131071
      KHALF=K/2
      DO 30 LT=1,17
        IF (LS.GT.KHALF) THEN
          LS=LS/2
          GO TO 30
        END IF
        LLS=K-LS
        DO 20 I=1,LLS
          IS=I+LS
          LA=ARRAY(IS)
          J=I
          JS=IS
   10     IF (LA.GE.ARRAY(J)) THEN
            ARRAY(JS)=LA
            GO TO 20
          ELSE
            ARRAY(JS)=ARRAY(J)
            JS=J
            J=J-LS
          END IF
          IF (J.GE.1) GO TO 10
          ARRAY(JS)=LA
   20   CONTINUE
        LS=LS/2
   30 CONTINUE
   40 CONTINUE
      RETURN
      END
! SUBROUTINE MXVSUM                ALL SYSTEMS                88/12/01
! 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)
      INTEGER N
      DOUBLE PRECISION X(*),Y(*),Z(*)
      INTEGER I
      DO 10 I=1,N
        Z(I)=X(I)+Y(I)
   10 CONTINUE
      RETURN
      END
! FUNCTION MXVVDP                  ALL SYSTEMS                92/12/01
! PURPOSE :
! COMPUTATION OF THE NUMBER MXVVDP=TRANS(X)*D**(-1)*Y WHERE D IS A
! DIAGONAL MATRIX STORED AS A VECTOR.
!
! PARAMETERS :
!  II  N  VECTOR DIMENSION.
!  RI  D(N)  DIAGONAL MATRIX STORED AS A VECTOR.
!  RI  X(N)  INPUT VECTOR.
!  RI  Y(N)  INPUT VECTOR.
!  RR  MXVVDP  COMPUTED NUMBER MXVVDP=TRANS(X)*D**(-1)*Y.
!
      FUNCTION MXVVDP (N, D, X, Y)
      INTEGER N
      DOUBLE PRECISION D(*),X(*),Y(*),MXVVDP
      DOUBLE PRECISION TEMP
      INTEGER I
      DOUBLE PRECISION ZERO
      PARAMETER  (ZERO=0.0D0)
      TEMP=ZERO
      DO 10 I=1,N
        TEMP=TEMP+X(I)*Y(I)/D(I)
   10 CONTINUE
      MXVVDP=TEMP
      RETURN
      END
! SUBROUTINE MXWDIR                ALL SYSTEMS                92/12/01
! PURPOSE :
! VECTOR AUGMENTED BY THE SCALED VECTOR IN THE PACKED CASE.
!
! PARAMETERS :
!  II  L  PACKED VECTOR DIMENSION.
!  II  N  VECTOR DIMENSION.
!  II  JBL(L)  INDICES OF PACKED VECTOR.
!  RI  A  SCALING FACTOR.
!  RI  X(L)  PACKED INPUT VECTOR.
!  RI  Y(N)  UNPACKED INPUT VECTOR.
!  RO  Z(N)  UNPACKED OR PACKED OUTPUT VECTOR WHERE Z:= Y + A*X.
!  II  JOB  FORM OF THE VECTOR Z. JOB=1-UNPACKED FORM. JOB=2-PACKED
!         FORM.
!
      SUBROUTINE MXWDIR (L, JBL, A, X, Y, Z, JOB)
      INTEGER L,JBL(*),JOB
      DOUBLE PRECISION A,X(*),Y(*),Z(*)
      INTEGER I,IP
      IF (JOB.EQ.1) THEN
        DO 10 I=1,L
          IP=JBL(I)
          IF (IP.GT.0) Z(IP)=Y(IP)+A*X(I)
   10   CONTINUE
      ELSE
        DO 20 I=1,L
          IP=JBL(I)
          IF (IP.GT.0) Z(I)=Y(IP)+A*X(I)
   20   CONTINUE
      END IF
      RETURN
      END
! FUNCTION MXWDOT                  ALL SYSTEMS                92/12/01
! PURPOSE :
! DOT PRODUCT OF TWO VECTORS IN THE PACKED CASE.
!
! PARAMETERS :
!  II  L  PACKED OR UNPACKED VECTOR DIMENSION.
!  II  N  UNPACKED VECTOR DIMENSION.
!  II  JBL(L)  INDICES OF PACKED VECTOR.
!  RI  X(L)  UNPACKED OR PACKED INPUT VECTOR.
!  RI  Y(N)  UNPACKED INPUT VECTOR.
!  II  JOB  FORM OF THE VECTOR X. JOB=1-UNPACKED FORM. JOB=2-PACKED
!          FORM.
!  RR  MXWDOT  VALUE OF DOT PRODUCT MXWDOT=TRANS(X)*Y.
!
      FUNCTION MXWDOT (L, JBL, X, Y, JOB)
      INTEGER L,JBL(*),JOB
      DOUBLE PRECISION X(*),Y(*),MXWDOT
      DOUBLE PRECISION TEMP
      INTEGER I,IP
      TEMP=0.0D0
      IF (JOB.EQ.1) THEN
        DO 10 I=1,L
          IP=JBL(I)
          IF (IP.GT.0) TEMP=TEMP+X(IP)*Y(IP)
   10   CONTINUE
      ELSE
        DO 20 I=1,L
          IP=JBL(I)
          IF (IP.GT.0) TEMP=TEMP+X(I)*Y(IP)
   20   CONTINUE
      END IF
      MXWDOT=TEMP
      RETURN
      END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!                                                                     !
!      TEST DRIVERS                                                   !
!                                                                     !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!     
!     TEST PROGRAM FOR THE SUBROUTINE PEQLU
!
      DOUBLE PRECISION F,FMIN,GMAX
      INTEGER I,IERR,IDER,ISPAS,IPRNT,ITERM,ITIME,M,MM,N
      INTEGER NITER,NFVAL,NSUCC,NITCG
      DOUBLE PRECISION AF(5000),RPAR(9),X(5000)
      INTEGER IAG(5001),IPAR(7),JAG(100000)
      INTEGER NEXT
      COMMON /PROB/ NEXT
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      NITER=0
      NFVAL=0
      NSUCC=0
      NITCG=0
      CALL TYTIM1 (ITIME)
!
!     LOOP FOR 30 TEST PROBLEMS
!
      DO 30 NEXT=1,30
!
!     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
        IDER=0
        ISPAS=2
        IPRNT=1
!
!     PROBLEM DIMENSION
!
        N=3000
        MM=10000
!
!     INITIATION OF X, DETERMINATION IAG AND JAG AND CHOICE OF RPAR(1)
!
        CALL TIUB18 (N, N, MM, X, IAG, JAG, FMIN, RPAR(1), NEXT, IERR)
        IF (NEXT.EQ.5) RPAR(8)=1.0D-3
        IF (NEXT.EQ.29) RPAR(8)=1.0D-2
        IF (NEXT.EQ.30) RPAR(8)=1.0D-2
        RPAR(1)=0.0D0
        IF (NEXT.EQ.5) RPAR(1)=1.0D4
        IF (NEXT.EQ.7) RPAR(1)=1.0D2
        IF (NEXT.EQ.9) RPAR(1)=1.0D1
        IF (NEXT.EQ.18) RPAR(1)=1.0D0
        IF (NEXT.EQ.22) RPAR(1)=1.0D4
        IF (IERR.NE.0) GO TO 30
!
!     SOLUTION
!
        CALL PEQLU (N, M, X, AF, IAG, JAG, IPAR, RPAR, F, GMAX, IDER,
     &   ISPAS, IPRNT, ITERM)
        NITER=NITER+NIT
        NFVAL=NFVAL+NFV
        NITCG=NITCG+NIN
        IF (ITERM.EQ.3) NSUCC=NSUCC+1
   30 CONTINUE
      WRITE (6,40) NITER,NFVAL,NITCG,NSUCC
   40 FORMAT (' NITER =',I5,3X,' NFVAL =',I5,3X,' NITCG =',I5,3X,' NSUCC
     & =',I5)
      CALL TYTIM2 (ITIME)
      STOP
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF FA)
!
      SUBROUTINE FUN (NF, KA, X, FA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),FA
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     FUNCTION EVALUATION
!
      CALL TAFU18 (NF, KA, X, FA, NEXT)
      RETURN
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF GA)
!
      SUBROUTINE DFUN (NF, KA, X, GA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),GA(*)
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     GRADIENT EVALUATION
!
      CALL TAGU18 (NF, KA, X, GA, NEXT)
      RETURN
      END
!     EMPTY SUBROUTINES
!
      SUBROUTINE OBJ (NF, X, FF)
      INTEGER NF
      DOUBLE PRECISION X(*),FF
      NF=1
      FF=X(1)
      END
      SUBROUTINE DOBJ (NF, X, GF)
      INTEGER NF
      DOUBLE PRECISION X(*),GF(*)
      NF=1
      GF(1)=X(1)
      RETURN
      END
!     TEST PROGRAM FOR THE SUBROUTINE PEQNU
!
      DOUBLE PRECISION F,FMIN,GMAX
      INTEGER I,IERR,IDER,ISPAS,IPRNT,ITERM,ITIME,M,MM,N
      INTEGER NITER,NFVAL,NSUCC,NITCG
      DOUBLE PRECISION AF(5000),RPAR(9),X(5000)
      INTEGER IAG(5001),IPAR(7),JAG(100000)
      INTEGER NEXT
      COMMON /PROB/ NEXT
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      NITER=0
      NFVAL=0
      NSUCC=0
      NITCG=0
      CALL TYTIM1 (ITIME)
!
!     LOOP FOR 30 TEST PROBLEMS
!
      DO 30 NEXT=1,30
!
!     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
        IDER=0
        ISPAS=2
        IPRNT=1
!
!     PROBLEM DIMENSION
!
        N=3000
        MM=10000
!
!     INITIATION OF X, DETERMINATION IAG AND JAG AND CHOICE OF RPAR(1)
!
        CALL TIUB18 (N, N, MM, X, IAG, JAG, FMIN, RPAR(1), NEXT, IERR)
        IF (NEXT.EQ.5) RPAR(8)=1.0D-3
        IF (NEXT.EQ.29) RPAR(8)=1.0D-2
        IF (NEXT.EQ.30) RPAR(8)=1.0D-2
        RPAR(1)=0.0D0
        IF (NEXT.EQ.5) RPAR(1)=1.0D5
        IF (NEXT.EQ.18) RPAR(1)=1.0D0
        IF (NEXT.EQ.23) RPAR(1)=1.0D1
        IF (IDER.EQ.1) THEN
          IF (NEXT.EQ.5) RPAR(1)=1.0D3
        END IF
        IF (IERR.NE.0) GO TO 30
!
!     SOLUTION
!
        CALL PEQNU (N, M, X, AF, IAG, JAG, IPAR, RPAR, F, GMAX, IDER,
     &   ISPAS, IPRNT, ITERM)
        NITER=NITER+NIT
        NFVAL=NFVAL+NFV
        NITCG=NITCG+NIN
        IF (ITERM.EQ.3) NSUCC=NSUCC+1
   30 CONTINUE
      WRITE (6,40) NITER,NFVAL,NITCG,NSUCC
   40 FORMAT (' NITER =',I5,3X,' NFVAL =',I5,3X,' NITCG =',I5,3X,' NSUCC
     & =',I5)
      CALL TYTIM2 (ITIME)
      STOP
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF FA)
!
      SUBROUTINE FUN (NF, KA, X, FA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),FA
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     FUNCTION EVALUATION
!
      CALL TAFU18 (NF, KA, X, FA, NEXT)
      RETURN
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF GA)
!
      SUBROUTINE DFUN (NF, KA, X, GA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),GA(*)
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     GRADIENT EVALUATION
!
      CALL TAGU18 (NF, KA, X, GA, NEXT)
      RETURN
      END
!     EMPTY SUBROUTINES
!
      SUBROUTINE OBJ (NF, X, FF)
      INTEGER NF
      DOUBLE PRECISION X(*),FF
      NF=1
      FF=X(1)
      END
      SUBROUTINE DOBJ (NF, X, GF)
      INTEGER NF
      DOUBLE PRECISION X(*),GF(*)
      NF=1
      GF(1)=X(1)
      RETURN
      END
!     TEST PROGRAM FOR THE SUBROUTINE PGACS
!
      INTEGER NF,NA,MA,IX(1000),IAG(6001),JAG(15000),IPAR(7),IDER,ISPAS,
     &IPRNT,ITERM
      DOUBLE PRECISION X(1000),XL(1000),XU(1000),AF(6000),RPAR(9),F,
     &GMAX
      INTEGER NEXT,IERR,I,ITIME
      INTEGER NITER,NFVAL,NGVAL,NSUCC,NITCG
      COMMON /PROB/ NEXT
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      NITER=0
      NFVAL=0
      NGVAL=0
      NSUCC=0
      NITCG=0
      CALL TYTIM1 (ITIME)
!
!     LOOP FOR 22 TEST PROBLEMS
!
      DO 30 NEXT=1,22
!
!     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
        IDER=1
        ISPAS=2
        IPRNT=1
!
!     PROBLEM DIMENSION
!
        NF=1000
        NA=6000
!
!     INITIATION OF X AND CHOICE OF RPAR(1) AND RPAR(6)
!
        CALL TIUB15 (NF, NA, MA, X, IAG, JAG, RPAR(6), RPAR(1), NEXT,
     &   IERR)
        IF (IERR.NE.0) GO TO 30
        CALL MXVINS (NF, 3, IX)
        CALL MXVSET (NF, -1.0D0, XL)
        CALL MXVSET (NF, 1.0D0, XU)
        RPAR(1)=0.0D0
        IF (NEXT.EQ.2) RPAR(1)=1.0D3
        IF (NEXT.EQ.5) RPAR(1)=1.0D1
        IF (NEXT.EQ.12) RPAR(1)=3.0D1
        IF (NEXT.EQ.17) RPAR(1)=3.0D0
        IF (NEXT.EQ.18) RPAR(1)=1.0D1
        IF (NEXT.EQ.21) RPAR(1)=2.0D1
!
!     SOLUTION
!
        CALL PGACS (NF, NA, MA, X, IX, XL, XU, AF, IAG, JAG, IPAR, RPAR,
     &    F, GMAX, IDER, ISPAS, IPRNT, ITERM)
        NITER=NITER+NIT
        NFVAL=NFVAL+NFV
        NGVAL=NGVAL+NFG
        NITCG=NITCG+NIN
        IF (ITERM.GT.0.AND.ITERM.LT.9) NSUCC=NSUCC+1
   30 CONTINUE
      WRITE (6,40) NITER,NFVAL,NGVAL,NITCG,NSUCC
   40 FORMAT (' NITER =',I5,3X,' NFVAL =',I5,3X,' NGVAL =',I5,3X,' NITCG
     & =',I5,3X,' NSUCC =',I5)
      CALL TYTIM2 (ITIME)
      STOP
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF FA)
!
      SUBROUTINE FUN (NF, KA, X, FA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),FA
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     FUNCTION EVALUATION
!
      CALL TAFU15 (NF, KA, X, FA, NEXT)
      RETURN
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF GA)
!
      SUBROUTINE DFUN (NF, KA, X, GA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),GA(*)
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     GRADIENT EVALUATION
!
      CALL TAGU15 (NF, KA, X, GA, NEXT)
      RETURN
      END
!     EMPTY SUBROUTINES
!
      SUBROUTINE OBJ (NF, X, FF)
      INTEGER NF
      DOUBLE PRECISION X(*),FF
      NF=1
      FF=X(1)
      END
      SUBROUTINE DOBJ (NF, X, GF)
      INTEGER NF
      DOUBLE PRECISION X(*),GF(*)
      NF=1
      GF(1)=X(1)
      RETURN
      END
!     TEST PROGRAM FOR THE SUBROUTINE PGACU
!
      INTEGER NF,NA,MA,IAG(6001),JAG(15000),IPAR(7),IDER,ISPAS,IPRNT,
     &ITERM
      DOUBLE PRECISION X(1000),AF(6000),RPAR(9),F,GMAX
      INTEGER NEXT,IERR,I,ITIME
      INTEGER NITER,NFVAL,NGVAL,NSUCC,NITCG
      COMMON /PROB/ NEXT
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      NITER=0
      NFVAL=0
      NGVAL=0
      NSUCC=0
      NITCG=0
      CALL TYTIM1 (ITIME)
!
!     LOOP FOR 22 TEST PROBLEMS
!
      DO 30 NEXT=1,22
!
!     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
        IDER=1
        ISPAS=2
        IPRNT=1
!
!     PROBLEM DIMENSION
!
        NF=1000
        NA=6000
!
!     INITIATION OF X AND CHOICE OF RPAR(1) AND RPAR(6)
!
        CALL TIUB15 (NF, NA, MA, X, IAG, JAG, RPAR(6), RPAR(1), NEXT,
     &   IERR)
        IF (IERR.NE.0) GO TO 30
        RPAR(1)=0.0D0
        IF (NEXT.EQ.7) RPAR(1)=1.0D1
!
!     SOLUTION
!
        CALL PGACU (NF, NA, MA, X, AF, IAG, JAG, IPAR, RPAR, F, GMAX,
     &   IDER, ISPAS, IPRNT, ITERM)
        NITER=NITER+NIT
        NFVAL=NFVAL+NFV
        NGVAL=NGVAL+NFG
        NITCG=NITCG+NIN
        IF (ITERM.GT.0.AND.ITERM.LT.9) NSUCC=NSUCC+1
   30 CONTINUE
      WRITE (6,40) NITER,NFVAL,NGVAL,NITCG,NSUCC
   40 FORMAT (' NITER =',I5,3X,' NFVAL =',I5,3X,' NGVAL =',I5,3X,' NITCG
     & =',I5,3X,' NSUCC =',I5)
      CALL TYTIM2 (ITIME)
      STOP
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF FA)
!
      SUBROUTINE FUN (NF, KA, X, FA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),FA
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     FUNCTION EVALUATION
!
      CALL TAFU15 (NF, KA, X, FA, NEXT)
      RETURN
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF GA)
!
      SUBROUTINE DFUN (NF, KA, X, GA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),GA(*)
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     GRADIENT EVALUATION
!
      CALL TAGU15 (NF, KA, X, GA, NEXT)
      RETURN
      END
!     EMPTY SUBROUTINES
!
      SUBROUTINE OBJ (NF, X, FF)
      INTEGER NF
      DOUBLE PRECISION X(*),FF
      NF=1
      FF=X(1)
      END
      SUBROUTINE DOBJ (NF, X, GF)
      INTEGER NF
      DOUBLE PRECISION X(*),GF(*)
      NF=1
      GF(1)=X(1)
      RETURN
      END
!     TEST PROGRAM FOR THE SUBROUTINE PGADS
!
      INTEGER NF,NA,MA,IX(1000),IAG(6001),JAG(15000),IPAR(7),IDER,ISPAS,
     &IPRNT,ITERM
      DOUBLE PRECISION X(1000),XL(1000),XU(1000),AF(6000),RPAR(9),F,
     &GMAX
      INTEGER NEXT,IERR,I,ITIME
      INTEGER NITER,NFVAL,NGVAL,NSUCC
      COMMON /PROB/ NEXT
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      NITER=0
      NFVAL=0
      NGVAL=0
      NSUCC=0
      CALL TYTIM1 (ITIME)
!
!     LOOP FOR 22 TEST PROBLEMS
!
      DO 30 NEXT=1,22
!
!     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
        IDER=1
        ISPAS=2
        IPRNT=1
!
!     PROBLEM DIMENSION
!
        NF=1000
        NA=6000
!
!     INITIATION OF X AND CHOICE OF RPAR(1) AND RPAR(6)
!
        CALL TIUB15 (NF, NA, MA, X, IAG, JAG, RPAR(6), RPAR(1), NEXT,
     &   IERR)
        IF (IERR.NE.0) GO TO 30
        CALL MXVINS (NF, 3, IX)
        CALL MXVSET (NF, -1.0D0, XL)
        CALL MXVSET (NF, 1.0D0, XU)
        RPAR(1)=0.0D0
        IF (IPAR(4).EQ.1) THEN
          IF (NEXT.EQ.5) RPAR(1)=1.0D1
          IF (NEXT.EQ.7) RPAR(1)=2.0D0
          IF (NEXT.EQ.10) RPAR(1)=1.0D0
          IF (NEXT.EQ.11) RPAR(1)=2.0D0
          IF (NEXT.EQ.15) RPAR(1)=5.0D0
          IF (NEXT.EQ.21) RPAR(1)=1.0D1
        ELSE
          IF (NEXT.EQ.2) RPAR(1)=1.0D3
          IF (NEXT.EQ.5) RPAR(1)=1.0D1
          IF (NEXT.EQ.12) RPAR(1)=3.0D1
          IF (NEXT.EQ.17) RPAR(1)=3.0D0
          IF (NEXT.EQ.18) RPAR(1)=1.0D1
          IF (NEXT.EQ.21) RPAR(1)=2.0D1
        END IF
!
!     SOLUTION
!
        CALL PGADS (NF, NA, MA, X, IX, XL, XU, AF, IAG, JAG, IPAR, RPAR,
     &    F, GMAX, IDER, ISPAS, IPRNT, ITERM)
        NITER=NITER+NIT
        NFVAL=NFVAL+NFV
        NGVAL=NGVAL+NFG
        IF (ITERM.GT.0.AND.ITERM.LT.9) NSUCC=NSUCC+1
   30 CONTINUE
      WRITE (6,40) NITER,NFVAL,NGVAL,NSUCC
   40 FORMAT (' NITER =',I5,3X,' NFVAL =',I5,3X,' NGVAL =',I5,3X,' NSUCC
     & =',I5)
      CALL TYTIM2 (ITIME)
      STOP
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF FA)
!
      SUBROUTINE FUN (NF, KA, X, FA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),FA
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     FUNCTION EVALUATION
!
      CALL TAFU15 (NF, KA, X, FA, NEXT)
      RETURN
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF GA)
!
      SUBROUTINE DFUN (NF, KA, X, GA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),GA(*)
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     GRADIENT EVALUATION
!
      CALL TAGU15 (NF, KA, X, GA, NEXT)
      RETURN
      END
!     EMPTY SUBROUTINES
!
      SUBROUTINE OBJ (NF, X, FF)
      INTEGER NF
      DOUBLE PRECISION X(*),FF
      NF=1
      FF=X(1)
      END
      SUBROUTINE DOBJ (NF, X, GF)
      INTEGER NF
      DOUBLE PRECISION X(*),GF(*)
      NF=1
      GF(1)=X(1)
      RETURN
      END
!     TEST PROGRAM FOR THE SUBROUTINE PGADU
!
      INTEGER NF,NA,MA,IAG(6001),JAG(15000),IPAR(7),IDER,ISPAS,IPRNT,
     &ITERM
      DOUBLE PRECISION X(1000),AF(6000),RPAR(9),F,GMAX
      INTEGER NEXT,IERR,I,ITIME
      INTEGER NITER,NFVAL,NGVAL,NSUCC
      COMMON /PROB/ NEXT
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      NITER=0
      NFVAL=0
      NGVAL=0
      NSUCC=0
      CALL TYTIM1 (ITIME)
!
!     LOOP FOR 22 TEST PROBLEMS
!
      DO 30 NEXT=1,22
!
!     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
        IDER=1
        ISPAS=2
        IPRNT=1
!
!     PROBLEM DIMENSION
!
        NF=1000
        NA=6000
!
!     INITIATION OF X AND CHOICE OF RPAR(1) AND RPAR(6)
!
        CALL TIUB15 (NF, NA, MA, X, IAG, JAG, RPAR(6), RPAR(1), NEXT,
     &   IERR)
        IF (IERR.NE.0) GO TO 30
        RPAR(1)=0.0D0
        IF (NEXT.EQ.12) RPAR(1)=1.0D1
        IF (NEXT.EQ.18) RPAR(1)=1.0D1
!
!     SOLUTION
!
        CALL PGADU (NF, NA, MA, X, AF, IAG, JAG, IPAR, RPAR, F, GMAX,
     &   IDER, ISPAS, IPRNT, ITERM)
        NITER=NITER+NIT
        NFVAL=NFVAL+NFV
        NGVAL=NGVAL+NFG
        IF (ITERM.GT.0.AND.ITERM.LT.9) NSUCC=NSUCC+1
   30 CONTINUE
      WRITE (6,40) NITER,NFVAL,NGVAL,NSUCC
   40 FORMAT (' NITER =',I5,3X,' NFVAL =',I5,3X,' NGVAL =',I5,3X,' NSUCC
     & =',I5)
      CALL TYTIM2 (ITIME)
      STOP
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF FA)
!
      SUBROUTINE FUN (NF, KA, X, FA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),FA
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     FUNCTION EVALUATION
!
      CALL TAFU15 (NF, KA, X, FA, NEXT)
      RETURN
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF GA)
!
      SUBROUTINE DFUN (NF, KA, X, GA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),GA(*)
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     GRADIENT EVALUATION
!
      CALL TAGU15 (NF, KA, X, GA, NEXT)
      RETURN
      END
!     EMPTY SUBROUTINES
!
      SUBROUTINE OBJ (NF, X, FF)
      INTEGER NF
      DOUBLE PRECISION X(*),FF
      NF=1
      FF=X(1)
      END
      SUBROUTINE DOBJ (NF, X, GF)
      INTEGER NF
      DOUBLE PRECISION X(*),GF(*)
      NF=1
      GF(1)=X(1)
      RETURN
      END
!     TEST PROGRAM FOR THE SUBROUTINE PLIPS
!
      INTEGER NF,IX(1000),IPAR(7),IPRNT,ITERM
      DOUBLE PRECISION X(1000),XL(1000),XU(1000),RPAR(9),F,GMAX
      INTEGER NEXT,IERR,I,ITIME
      INTEGER NITER,NFVAL,NSUCC
      COMMON /PROB/ NEXT
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      NITER=0
      NFVAL=0
      NSUCC=0
      CALL TYTIM1 (ITIME)
!
!     LOOP FOR 22 TEST PROBLEMS
!
      DO 30 NEXT=1,22
!
!     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
        IPRNT=1
!
!     PROBLEM DIMENSION
!
        NF=1000
!
!     INITIATION OF X AND CHOICE OF RPAR(1) AND RPAR(6)
!
        CALL TIUD14 (NF, X, RPAR(6), RPAR(1), NEXT, IERR)
        IF (IERR.NE.0) GO TO 30
        CALL MXVINS (NF, 3, IX)
        CALL MXVSET (NF, -1.0D0, XL)
        CALL MXVSET (NF, 1.0D0, XU)
        IF (RPAR(6).EQ.0.0D0) IPAR(4)=1
        RPAR(1)=0.0D0
!
!     SOLUTION
!
        CALL PLIPS (NF, X, IX, XL, XU, IPAR, RPAR, F, GMAX, IPRNT,
     &   ITERM)
        NITER=NITER+NIT
        NFVAL=NFVAL+NFV
        IF (ITERM.GT.0.AND.ITERM.LT.9) NSUCC=NSUCC+1
   30 CONTINUE
      WRITE (6,40) NITER,NFVAL,NFVAL,NSUCC
   40 FORMAT (' NITER =',I5,3X,' NFVAL =',I5,3X,' NGVAL =',I5,3X,' NSUCC
     & =',I5)
      CALL TYTIM2 (ITIME)
      STOP
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF FF)
!
      SUBROUTINE OBJ (NF, X, FF)
      INTEGER NF
      DOUBLE PRECISION X(*),FF
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     FUNCTION EVALUATION
!
      CALL TFFU14 (NF, X, FF, NEXT)
      RETURN
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF GF)
!
      SUBROUTINE DOBJ (NF, X, GF)
      INTEGER NF
      DOUBLE PRECISION X(*),GF(*)
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     GRADIENT EVALUATION
!
      CALL TFGU14 (NF, X, GF, NEXT)
      RETURN
      END
!
!     EMPTY SUBROUTINES
!
      SUBROUTINE FUN (NF, KA, X, FA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),FA
      KA=NF
      FA=X(1)
      RETURN
      END
      SUBROUTINE DFUN (NF, KA, X, GA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),GA(*)
      KA=NF
      GA(1)=X(1)
      RETURN
      END
!     TEST PROGRAM FOR THE SUBROUTINE PLIPU
!
      INTEGER NF,IPAR(7),IPRNT,ITERM
      DOUBLE PRECISION X(1000),RPAR(9),F,GMAX
      INTEGER NEXT,IERR,I,ITIME
      INTEGER NITER,NFVAL,NSUCC
      COMMON /PROB/ NEXT
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      NITER=0
      NFVAL=0
      NSUCC=0
      CALL TYTIM1 (ITIME)
!
!     LOOP FOR 22 TEST PROBLEMS
!
      DO 30 NEXT=1,22
!
!     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
        IPRNT=1
!
!     PROBLEM DIMENSION
!
        NF=1000
!
!     INITIATION OF X AND CHOICE OF RPAR(1) AND RPAR(6)
!
        CALL TIUD14 (NF, X, RPAR(6), RPAR(1), NEXT, IERR)
        IF (IERR.NE.0) GO TO 30
        IF (RPAR(6).EQ.0.0D0) IPAR(4)=1
        IF (NEXT.EQ.2) IPAR(4)=0
        RPAR(1)=0.0D0
        IF (NEXT.EQ.18) RPAR(1)=1.0D1
!
!     SOLUTION
!
        CALL PLIPU (NF, X, IPAR, RPAR, F, GMAX, IPRNT, ITERM)
        NITER=NITER+NIT
        NFVAL=NFVAL+NFV
        IF (ITERM.GT.0.AND.ITERM.LT.9) NSUCC=NSUCC+1
   30 CONTINUE
      WRITE (6,40) NITER,NFVAL,NFVAL,NSUCC
   40 FORMAT (' NITER =',I5,3X,' NFVAL =',I5,3X,' NGVAL =',I5,3X,' NSUCC
     & =',I5)
      CALL TYTIM2 (ITIME)
      STOP
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF FF)
!
      SUBROUTINE OBJ (NF, X, FF)
      INTEGER NF
      DOUBLE PRECISION X(*),FF
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     FUNCTION EVALUATION
!
      CALL TFFU14 (NF, X, FF, NEXT)
      RETURN
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF GF)
!
      SUBROUTINE DOBJ (NF, X, GF)
      INTEGER NF
      DOUBLE PRECISION X(*),GF(*)
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     GRADIENT EVALUATION
!
      CALL TFGU14 (NF, X, GF, NEXT)
      RETURN
      END
!
!     EMPTY SUBROUTINES
!
      SUBROUTINE FUN (NF, KA, X, FA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),FA
      KA=NF
      FA=X(1)
      RETURN
      END
      SUBROUTINE DFUN (NF, KA, X, GA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),GA(*)
      KA=NF
      GA(1)=X(1)
      RETURN
      END
!     TEST PROGRAM FOR THE SUBROUTINE PLISS
!
      INTEGER NF,IX(1000),IPAR(7),IPRNT,ITERM
      DOUBLE PRECISION X(1000),XL(1000),XU(1000),RPAR(9),F,GMAX
      INTEGER NEXT,IERR,I,ITIME
      INTEGER NITER,NFVAL,NSUCC
      COMMON /PROB/ NEXT
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      NITER=0
      NFVAL=0
      NSUCC=0
      CALL TYTIM1 (ITIME)
!
!     LOOP FOR 22 TEST PROBLEMS
!
      DO 30 NEXT=1,22
!
!     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
        IPRNT=1
!
!     PROBLEM DIMENSION
!
        NF=1000
!
!     INITIATION OF X AND CHOICE OF RPAR(1) AND RPAR(6)
!
        CALL TIUD14 (NF, X, RPAR(6), RPAR(1), NEXT, IERR)
        IF (IERR.NE.0) GO TO 30
        CALL MXVINS (NF, 3, IX)
        CALL MXVSET (NF, -1.0D0, XL)
        CALL MXVSET (NF, 1.0D0, XU)
        IF (RPAR(6).EQ.0.0D0) IPAR(4)=1
        RPAR(1)=0.0D0
!
!     SOLUTION
!
        CALL PLISS (NF, X, IX, XL, XU, IPAR, RPAR, F, GMAX, IPRNT,
     &   ITERM)
        NITER=NITER+NIT
        NFVAL=NFVAL+NFV
        IF (ITERM.GT.0.AND.ITERM.LT.9) NSUCC=NSUCC+1
   30 CONTINUE
      WRITE (6,40) NITER,NFVAL,NFVAL,NSUCC
   40 FORMAT (' NITER =',I5,3X,' NFVAL =',I5,3X,' NGVAL =',I5,3X,' NSUCC
     & =',I5)
      CALL TYTIM2 (ITIME)
      STOP
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF FF)
!
      SUBROUTINE OBJ (NF, X, FF)
      INTEGER NF
      DOUBLE PRECISION X(*),FF
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     FUNCTION EVALUATION
!
      CALL TFFU14 (NF, X, FF, NEXT)
      RETURN
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF GF)
!
      SUBROUTINE DOBJ (NF, X, GF)
      INTEGER NF
      DOUBLE PRECISION X(*),GF(*)
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     GRADIENT EVALUATION
!
      CALL TFGU14 (NF, X, GF, NEXT)
      RETURN
      END
!     EMPTY SUBROUTINES
!
      SUBROUTINE FUN (NF, KA, X, FA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),FA
      KA=NF
      FA=X(1)
      RETURN
      END
      SUBROUTINE DFUN (NF, KA, X, GA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),GA(*)
      KA=NF
      GA(1)=X(1)
      RETURN
      END
!     TEST PROGRAM FOR THE SUBROUTINE PLISU
!
      INTEGER NF,IPAR(7),IPRNT,ITERM
      DOUBLE PRECISION X(1000),RPAR(9),F,GMAX
      INTEGER NEXT,IERR,I,ITIME
      INTEGER NITER,NFVAL,NSUCC
      COMMON /PROB/ NEXT
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      NITER=0
      NFVAL=0
      NSUCC=0
      CALL TYTIM1 (ITIME)
!
!     LOOP FOR 22 TEST PROBLEMS
!
      DO 30 NEXT=1,22
!
!     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
        IPRNT=1
!
!     PROBLEM DIMENSION
!
        NF=1000
!
!     INITIATION OF X AND CHOICE OF RPAR(1) AND RPAR(6)
!
        CALL TIUD14 (NF, X, RPAR(6), RPAR(1), NEXT, IERR)
        IF (IERR.NE.0) GO TO 30
        IF (RPAR(6).EQ.0.0D0) IPAR(4)=1
        IF (NEXT.EQ.2) IPAR(4)=0
        RPAR(1)=0.0D0
        IF (NEXT.EQ.18) RPAR(1)=1.0D1
!
!     SOLUTION
!
        CALL PLISU (NF, X, IPAR, RPAR, F, GMAX, IPRNT, ITERM)
        NITER=NITER+NIT
        NFVAL=NFVAL+NFV
        IF (ITERM.GT.0.AND.ITERM.LT.9) NSUCC=NSUCC+1
   30 CONTINUE
      WRITE (6,40) NITER,NFVAL,NFVAL,NSUCC
   40 FORMAT (' NITER =',I5,3X,' NFVAL =',I5,3X,' NGVAL =',I5,3X,' NSUCC
     & =',I5)
      CALL TYTIM2 (ITIME)
      STOP
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF FF)
!
      SUBROUTINE OBJ (NF, X, FF)
      INTEGER NF
      DOUBLE PRECISION X(*),FF
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     FUNCTION EVALUATION
!
      CALL TFFU14 (NF, X, FF, NEXT)
      RETURN
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF GF)
!
      SUBROUTINE DOBJ (NF, X, GF)
      INTEGER NF
      DOUBLE PRECISION X(*),GF(*)
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     GRADIENT EVALUATION
!
      CALL TFGU14 (NF, X, GF, NEXT)
      RETURN
      END
!     EMPTY SUBROUTINES
!
      SUBROUTINE FUN (NF, KA, X, FA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),FA
      KA=NF
      FA=X(1)
      RETURN
      END
      SUBROUTINE DFUN (NF, KA, X, GA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),GA(*)
      KA=NF
      GA(1)=X(1)
      RETURN
      END
!     TEST PROGRAM FOR THE SUBROUTINE PMAXU
!
      INTEGER NF,NA,MA,IAG(6001),JAG(20000),IPAR(7),IEXT,ISPAS,IPRNT,
     &ITERM
      DOUBLE PRECISION X(201),AF(6000),RPAR(9),F,GMAX
      INTEGER NEXT,IERR,I,ITIME
      INTEGER NITER,NFVAL,NGVAL,NSUCC
      COMMON /PROB/ NEXT
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      NITER=0
      NFVAL=0
      NGVAL=0
      NSUCC=0
      CALL TYTIM1 (ITIME)
!
!     LOOP FOR 22 TEST PROBLEMS
!
      DO 30 NEXT=1,22
!
!     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
        IEXT=-1
        ISPAS=2
        IPRNT=1
!
!     PROBLEM DIMENSION
!
        NF=200
        NA=6000
!
!     INITIATION OF X AND CHOICE OF RPAR(1) AND RPAR(6)
!
        CALL TIUB14 (NF, NA, MA, X, IAG, JAG, RPAR(6), RPAR(1), NEXT,
     &   IERR)
        IF (IERR.NE.0) GO TO 30
        IF (IPAR(5).LE.1) THEN
          IF (NEXT.EQ.5) RPAR(1)=1.0D1
          IF (NEXT.EQ.7) RPAR(1)=1.0D0
          IF (NEXT.EQ.10) RPAR(1)=8.0D0
          IF (NEXT.EQ.14) RPAR(1)=1.0D0
        ELSE
          IF (NEXT.EQ.1) RPAR(9)=1.0D-6
          IF (NEXT.EQ.9) RPAR(1)=2.8D1
          IF (NEXT.EQ.10) RPAR(1)=5.0D0
          IF (NEXT.EQ.16) RPAR(1)=1.0D1
        END IF
!
!     SOLUTION
!
        CALL PMAXU (NF, NA, MA, X, AF, IAG, JAG, IPAR, RPAR, F, GMAX,
     &   IEXT, ISPAS, IPRNT, ITERM)
        NITER=NITER+NIT
        NFVAL=NFVAL+NFV
        NGVAL=NGVAL+NFG
        IF (ITERM.GT.0.AND.ITERM.LE.10) NSUCC=NSUCC+1
   30 CONTINUE
      WRITE (6,40) NITER,NFVAL,NGVAL,NSUCC
   40 FORMAT (' NITER =',I5,3X,' NFVAL =',I5,3X,' NGVAL =',I5,3X,' NSUCC
     & =',I5)
      CALL TYTIM2 (ITIME)
      STOP
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF FA)
!
      SUBROUTINE FUN (NF, KA, X, FA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),FA
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     FUNCTION EVALUATION
!
      CALL TAFU14 (NF, KA, X, FA, NEXT)
      RETURN
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF GA)
!
      SUBROUTINE DFUN (NF, KA, X, GA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),GA(*)
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     GRADIENT EVALUATION
!
      CALL TAGU14 (NF, KA, X, GA, NEXT)
      RETURN
      END
!     EMPTY SUBROUTINES
!
      SUBROUTINE OBJ (NF, X, FF)
      INTEGER NF
      DOUBLE PRECISION X(*),FF
      NF=1
      FF=X(1)
      END
      SUBROUTINE DOBJ (NF, X, GF)
      INTEGER NF
      DOUBLE PRECISION X(*),GF(*)
      NF=1
      GF(1)=X(1)
      RETURN
      END
!     TEST PROGRAM FOR THE SUBROUTINE PNECS
!
      INTEGER NF,IX(1000),IH(1001),JH(8000),IPAR(7),ISPAS,IPRNT,ITERM
      DOUBLE PRECISION X(1000),XL(1000),XU(1000),RPAR(9),F,GMAX
      INTEGER NEXT,IERR,I,ITIME,M
      INTEGER NITER,NFVAL,NGVAL,NSUCC,NITCG
      COMMON /PROB/ NEXT
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      NITER=0
      NFVAL=0
      NGVAL=0
      NSUCC=0
      NITCG=0
      CALL TYTIM1 (ITIME)
!
!     LOOP FOR 22 TEST PROBLEMS
!
      DO 30 NEXT=1,22
!
!     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
        ISPAS=2
        IPRNT=1
!
!     PROBLEM DIMENSION
!
        NF=1000
!
!     INITIATION OF X AND CHOICE OF RPAR(1) AND RPAR(6)
!
        CALL TIUS14 (NF, M, X, IH, JH, RPAR(6), RPAR(1), NEXT, IERR)
        IF (IERR.NE.0) GO TO 30
        IF (RPAR(6).EQ.0.0D0) IPAR(4)=1
        CALL MXVINS (NF, 3, IX)
        CALL MXVSET (NF, -1.0D0, XL)
        CALL MXVSET (NF, 1.0D0, XU)
        RPAR(1)=0.0D0
        IF (NEXT.EQ.2) RPAR(1)=5.0D1
        IF (NEXT.EQ.12) RPAR(1)=1.0D0
        IF (NEXT.EQ.18) RPAR(1)=1.0D1
!
!     SOLUTION
!
        CALL PNECS (NF, M, X, IX, XL, XU, IH, JH, IPAR, RPAR, F, GMAX,
     &   ISPAS, IPRNT, ITERM)
        NITER=NITER+NIT
        NFVAL=NFVAL+NFV
        NGVAL=NGVAL+NFG
        NITCG=NITCG+NIN
        IF (ITERM.GT.0.AND.ITERM.LT.9) NSUCC=NSUCC+1
   30 CONTINUE
      WRITE (6,40) NITER,NFVAL,NGVAL,NITCG,NSUCC
   40 FORMAT (' NITER =',I5,3X,' NFVAL =',I5,3X,' NGVAL =',I5,3X,' NITCG
     & =',I5,3X,' NSUCC =',I5)
      CALL TYTIM2 (ITIME)
      STOP
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF FF)
!
      SUBROUTINE OBJ (NF, X, FF)
      INTEGER NF
      DOUBLE PRECISION X(*),FF
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     FUNCTION EVALUATION
!
      CALL TFFU14 (NF, X, FF, NEXT)
      RETURN
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF GF)
!
      SUBROUTINE DOBJ (NF, X, GF)
      INTEGER NF
      DOUBLE PRECISION X(*),GF(*)
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     GRADIENT EVALUATION
!
      CALL TFGU14 (NF, X, GF, NEXT)
      RETURN
      END
!     EMPTY SUBROUTINES
!
      SUBROUTINE FUN (NF, KA, X, FA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),FA
      KA=NF
      FA=X(1)
      RETURN
      END
      SUBROUTINE DFUN (NF, KA, X, GA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),GA(*)
      KA=NF
      GA(1)=X(1)
      RETURN
      END
!     TEST PROGRAM FOR THE SUBROUTINE PNECU
!
      INTEGER NF,IH(1001),JH(8000),IPAR(7),ISPAS,IPRNT,ITERM
      DOUBLE PRECISION X(1000),RPAR(9),F,GMAX
      INTEGER NEXT,IERR,I,ITIME,M
      INTEGER NITER,NFVAL,NGVAL,NSUCC,NITCG
      COMMON /PROB/ NEXT
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      NITER=0
      NFVAL=0
      NGVAL=0
      NSUCC=0
      NITCG=0
      CALL TYTIM1 (ITIME)
!
!     LOOP FOR 22 TEST PROBLEMS
!
      DO 30 NEXT=1,22
!
!     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
        ISPAS=2
        IPRNT=1
!
!     PROBLEM DIMENSION
!
        NF=1000
!
!     INITIATION OF X AND CHOICE OF RPAR(1) AND RPAR(6)
!
        CALL TIUS14 (NF, M, X, IH, JH, RPAR(6), RPAR(1), NEXT, IERR)
        IF (IERR.NE.0) GO TO 30
        IF (RPAR(6).EQ.0.0D0) IPAR(4)=1
        RPAR(1)=0.0D0
        IF (NEXT.EQ.1) RPAR(1)=4.0D0
!
!     SOLUTION
!
        CALL PNECU (NF, M, X, IH, JH, IPAR, RPAR, F, GMAX, ISPAS, IPRNT,
     &    ITERM)
        NITER=NITER+NIT
        NFVAL=NFVAL+NFV
        NGVAL=NGVAL+NFG
        NITCG=NITCG+NIN
        IF (ITERM.GT.0.AND.ITERM.LT.9) NSUCC=NSUCC+1
   30 CONTINUE
      WRITE (6,40) NITER,NFVAL,NGVAL,NITCG,NSUCC
   40 FORMAT (' NITER =',I5,3X,' NFVAL =',I5,3X,' NGVAL =',I5,3X,' NITCG
     & =',I5,3X,' NSUCC =',I5)
      CALL TYTIM2 (ITIME)
      STOP
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF FF)
!
      SUBROUTINE OBJ (NF, X, FF)
      INTEGER NF
      DOUBLE PRECISION X(*),FF
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     FUNCTION EVALUATION
!
      CALL TFFU14 (NF, X, FF, NEXT)
      RETURN
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF GF)
!
      SUBROUTINE DOBJ (NF, X, GF)
      INTEGER NF
      DOUBLE PRECISION X(*),GF(*)
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     GRADIENT EVALUATION
!
      CALL TFGU14 (NF, X, GF, NEXT)
      RETURN
      END
!     EMPTY SUBROUTINES
!
      SUBROUTINE FUN (NF, KA, X, FA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),FA
      KA=NF
      FA=X(1)
      RETURN
      END
      SUBROUTINE DFUN (NF, KA, X, GA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),GA(*)
      KA=NF
      GA(1)=X(1)
      RETURN
      END
!     TEST PROGRAM FOR THE SUBROUTINE PNEDS
!
      INTEGER NF,IX(1000),IH(1001),JH(8000),IPAR(7),ISPAS,IPRNT,ITERM
      DOUBLE PRECISION X(1000),XL(1000),XU(1000),RPAR(9),F,GMAX
      INTEGER NEXT,IERR,I,ITIME,M
      INTEGER NITER,NFVAL,NGVAL,NSUCC
      COMMON /PROB/ NEXT
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      NITER=0
      NFVAL=0
      NGVAL=0
      NSUCC=0
      CALL TYTIM1 (ITIME)
!
!     LOOP FOR 22 TEST PROBLEMS
!
      DO 30 NEXT=1,22
!
!     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
        ISPAS=2
        IPRNT=1
!
!     PROBLEM DIMENSION
!
        NF=1000
!
!     INITIATION OF X AND CHOICE OF RPAR(1) AND RPAR(6)
!
        CALL TIUS14 (NF, M, X, IH, JH, RPAR(6), RPAR(1), NEXT, IERR)
        IF (IERR.NE.0) GO TO 30
        IF (RPAR(6).EQ.0.0D0) IPAR(4)=1
        CALL MXVINS (NF, 3, IX)
        CALL MXVSET (NF, -1.0D0, XL)
        CALL MXVSET (NF, 1.0D0, XU)
        RPAR(1)=0.0D0
        IF (NEXT.EQ.9) RPAR(1)=1.0D2
        IF (NEXT.EQ.12) RPAR(1)=1.0D0
!
!     SOLUTION
!
        CALL PNEDS (NF, M, X, IX, XL, XU, IH, JH, IPAR, RPAR, F, GMAX,
     &   ISPAS, IPRNT, ITERM)
        NITER=NITER+NIT
        NFVAL=NFVAL+NFV
        NGVAL=NGVAL+NFG
        IF (ITERM.GT.0.AND.ITERM.LT.9) NSUCC=NSUCC+1
   30 CONTINUE
      WRITE (6,40) NITER,NFVAL,NGVAL,NSUCC
   40 FORMAT (' NITER =',I5,3X,' NFVAL =',I5,3X,' NGVAL =',I5,3X,' NSUCC
     & =',I5)
      CALL TYTIM2 (ITIME)
      STOP
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF FF)
!
      SUBROUTINE OBJ (NF, X, FF)
      INTEGER NF
      DOUBLE PRECISION X(*),FF
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     FUNCTION EVALUATION
!
      CALL TFFU14 (NF, X, FF, NEXT)
      RETURN
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF GF)
!
      SUBROUTINE DOBJ (NF, X, GF)
      INTEGER NF
      DOUBLE PRECISION X(*),GF(*)
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     GRADIENT EVALUATION
!
      CALL TFGU14 (NF, X, GF, NEXT)
      RETURN
      END
!     EMPTY SUBROUTINES
!
      SUBROUTINE FUN (NF, KA, X, FA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),FA
      KA=NF
      FA=X(1)
      RETURN
      END
      SUBROUTINE DFUN (NF, KA, X, GA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),GA(*)
      KA=NF
      GA(1)=X(1)
      RETURN
      END
!     TEST PROGRAM FOR THE SUBROUTINE PNEDU
!
      INTEGER NF,IH(1001),JH(8000),IPAR(7),ISPAS,IPRNT,ITERM
      DOUBLE PRECISION X(1000),RPAR(9),F,GMAX
      INTEGER NEXT,IERR,I,ITIME,M
      INTEGER NITER,NFVAL,NGVAL,NSUCC
      COMMON /PROB/ NEXT
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      NITER=0
      NFVAL=0
      NGVAL=0
      NSUCC=0
      CALL TYTIM1 (ITIME)
!
!     LOOP FOR 22 TEST PROBLEMS
!
      DO 30 NEXT=1,22
!
!     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
        ISPAS=2
        IPRNT=1
!
!     PROBLEM DIMENSION
!
        NF=1000
!
!     INITIATION OF X AND CHOICE OF RPAR(1) AND RPAR(6)
!
        CALL TIUS14 (NF, M, X, IH, JH, RPAR(6), RPAR(1), NEXT, IERR)
        IF (IERR.NE.0) GO TO 30
        IF (RPAR(6).EQ.0.0D0) IPAR(4)=1
        RPAR(1)=0.0D0
        IF (NEXT.EQ.1) RPAR(1)=3.0D0
        IF (NEXT.EQ.10) RPAR(1)=2.0D0
!
!     SOLUTION
!
        CALL PNEDU (NF, M, X, IH, JH, IPAR, RPAR, F, GMAX, ISPAS, IPRNT,
     &    ITERM)
        NITER=NITER+NIT
        NFVAL=NFVAL+NFV
        NGVAL=NGVAL+NFG
        IF (ITERM.GT.0.AND.ITERM.LT.9) NSUCC=NSUCC+1
   30 CONTINUE
      WRITE (6,40) NITER,NFVAL,NGVAL,NSUCC
   40 FORMAT (' NITER =',I5,3X,' NFVAL =',I5,3X,' NGVAL =',I5,3X,' NSUCC
     & =',I5)
      CALL TYTIM2 (ITIME)
      STOP
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF FF)
!
      SUBROUTINE OBJ (NF, X, FF)
      INTEGER NF
      DOUBLE PRECISION X(*),FF
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     FUNCTION EVALUATION
!
      CALL TFFU14 (NF, X, FF, NEXT)
      RETURN
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF GF)
!
      SUBROUTINE DOBJ (NF, X, GF)
      INTEGER NF
      DOUBLE PRECISION X(*),GF(*)
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     GRADIENT EVALUATION
!
      CALL TFGU14 (NF, X, GF, NEXT)
      RETURN
      END
!     EMPTY SUBROUTINES
!
      SUBROUTINE FUN (NF, KA, X, FA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),FA
      KA=NF
      FA=X(1)
      RETURN
      END
      SUBROUTINE DFUN (NF, KA, X, GA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),GA(*)
      KA=NF
      GA(1)=X(1)
      RETURN
      END
!     TEST PROGRAM FOR THE SUBROUTINE PNETS
!
      INTEGER NF,IX(1000),IPAR(7),IHES,IPRNT,ITERM
      DOUBLE PRECISION X(1000),XL(1000),XU(1000),RPAR(9),F,GMAX
      INTEGER NEXT,IERR,I,ITIME
      INTEGER NITER,NFVAL,NGVAL,NSUCC
      COMMON /PROB/ NEXT
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      NITER=0
      NFVAL=0
      NGVAL=0
      NSUCC=0
      CALL TYTIM1 (ITIME)
!
!     LOOP FOR 22 TEST PROBLEMS
!
      DO 30 NEXT=1,22
!
!     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
        IHES=0
        IPRNT=1
!
!     PROBLEM DIMENSION
!
        NF=1000
!
!     INITIATION OF X AND CHOICE OF RPAR(1) AND RPAR(6)
!
        CALL TIUD14 (NF, X, RPAR(6), RPAR(1), NEXT, IERR)
        IF (IERR.NE.0) GO TO 30
        CALL MXVINS (NF, 3, IX)
        CALL MXVSET (NF, -1.0D0, XL)
        CALL MXVSET (NF, 1.0D0, XU)
        IF (RPAR(6).EQ.0.0D0) IPAR(4)=1
        RPAR(1)=0.0D0
!
!     SOLUTION
!
        CALL PNETS (NF, X, IX, XL, XU, IPAR, RPAR, F, GMAX, IHES, IPRNT,
     &    ITERM)
        NITER=NITER+NIT
        NFVAL=NFVAL+NFV
        NGVAL=NGVAL+NFG
        IF (ITERM.GT.0.AND.ITERM.LT.9) NSUCC=NSUCC+1
   30 CONTINUE
      WRITE (6,40) NITER,NFVAL,NGVAL,NSUCC
   40 FORMAT (' NITER =',I5,3X,' NFVAL =',I5,3X,' NGVAL =',I5,3X,' NSUCC
     & =',I5)
      CALL TYTIM2 (ITIME)
      STOP
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF FF)
!
      SUBROUTINE OBJ (NF, X, FF)
      INTEGER NF
      DOUBLE PRECISION X(*),FF
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     FUNCTION EVALUATION
!
      CALL TFFU14 (NF, X, FF, NEXT)
      RETURN
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF GF)
!
      SUBROUTINE DOBJ (NF, X, GF)
      INTEGER NF
      DOUBLE PRECISION X(*),GF(*)
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     GRADIENT EVALUATION
!
      CALL TFGU14 (NF, X, GF, NEXT)
      RETURN
      END
!     EMPTY SUBROUTINES
!
      SUBROUTINE HVEC (NF, X, D, HD)
      INTEGER NF
      DOUBLE PRECISION X(*),D(*),HD(*)
      NF=1
      D(1)=X(1)
      HD(1)=X(1)
      RETURN
      END
      SUBROUTINE FUN (NF, KA, X, FA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),FA
      KA=NF
      FA=X(1)
      RETURN
      END
      SUBROUTINE DFUN (NF, KA, X, GA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),GA(*)
      KA=NF
      GA(1)=X(1)
      RETURN
      END
!     TEST PROGRAM FOR THE SUBROUTINE PNETU
!
      INTEGER NF,IPAR(7),IHES,IPRNT,ITERM
      DOUBLE PRECISION X(1000),RPAR(9),F,GMAX
      INTEGER NEXT,IERR,I,ITIME
      INTEGER NITER,NFVAL,NGVAL,NSUCC
      COMMON /PROB/ NEXT
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      NITER=0
      NFVAL=0
      NGVAL=0
      NSUCC=0
      CALL TYTIM1 (ITIME)
!
!     LOOP FOR 22 TEST PROBLEMS
!
      DO 30 NEXT=1,22
!
!     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
        IHES=0
        IPRNT=1
!
!     PROBLEM DIMENSION
!
        NF=1000
!
!     INITIATION OF X AND CHOICE OF RPAR(1) AND RPAR(6)
!
        CALL TIUD14 (NF, X, RPAR(6), RPAR(1), NEXT, IERR)
        IF (IERR.NE.0) GO TO 30
        IF (RPAR(6).EQ.0.0D0) IPAR(4)=1
        IF (NEXT.EQ.2) IPAR(4)=0
        RPAR(1)=0.0D0
        IF (NEXT.EQ.10) RPAR(1)=3.5D1
        IF (NEXT.EQ.18) RPAR(1)=1.0D1
!
!     SOLUTION
!
        CALL PNETU (NF, X, IPAR, RPAR, F, GMAX, IHES, IPRNT, ITERM)
        NITER=NITER+NIT
        NFVAL=NFVAL+NFV
        NGVAL=NGVAL+NFG
        IF (ITERM.GT.0.AND.ITERM.LT.9) NSUCC=NSUCC+1
   30 CONTINUE
      WRITE (6,40) NITER,NFVAL,NGVAL,NSUCC
   40 FORMAT (' NITER =',I5,3X,' NFVAL =',I5,3X,' NGVAL =',I5,3X,' NSUCC
     & =',I5)
      CALL TYTIM2 (ITIME)
      STOP
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF FF)
!
      SUBROUTINE OBJ (NF, X, FF)
      INTEGER NF
      DOUBLE PRECISION X(*),FF
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     FUNCTION EVALUATION
!
      CALL TFFU14 (NF, X, FF, NEXT)
      RETURN
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF GF)
!
      SUBROUTINE DOBJ (NF, X, GF)
      INTEGER NF
      DOUBLE PRECISION X(*),GF(*)
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     GRADIENT EVALUATION
!
      CALL TFGU14 (NF, X, GF, NEXT)
      RETURN
      END
!     EMPTY SUBROUTINES
!
      SUBROUTINE HVEC (NF, X, D, HD)
      INTEGER NF
      DOUBLE PRECISION X(*),D(*),HD(*)
      NF=1
      D(1)=X(1)
      HD(1)=X(1)
      RETURN
      END
      SUBROUTINE FUN (NF, KA, X, FA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),FA
      KA=NF
      FA=X(1)
      RETURN
      END
      SUBROUTINE DFUN (NF, KA, X, GA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),GA(*)
      KA=NF
      GA(1)=X(1)
      RETURN
      END
!     TEST PROGRAM FOR THE SUBROUTINE PSECS
!
      INTEGER NF,NA,MA,IX(1000),IAG(2001),JAG(8000),IPAR(7),ISPAS,IPRNT,
     &ITERM
      DOUBLE PRECISION X(1000),XL(1000),XU(1000),AF(2000),RPAR(9),F,
     &GMAX
      INTEGER NEXT,IERR,I,ITIME
      INTEGER NITER,NFVAL,NSUCC,NITCG
      COMMON /PROB/ NEXT
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      NITER=0
      NFVAL=0
      NSUCC=0
      NITCG=0
      CALL TYTIM1 (ITIME)
!
!     LOOP FOR 22 TEST PROBLEMS
!
      DO 30 NEXT=1,22
!
!     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
        ISPAS=2
        IPRNT=1
!
!     PROBLEM DIMENSION
!
        NF=1000
        NA=2000
!
!     INITIATION OF X AND CHOICE OF RPAR(1) AND RPAR(6)
!
        CALL TIUB14 (NF, NA, MA, X, IAG, JAG, RPAR(6), RPAR(1), NEXT,
     &   IERR)
        IF (IERR.NE.0) GO TO 30
        CALL MXVINS (NF, 3, IX)
        CALL MXVSET (NF, -1.0D0, XL)
        CALL MXVSET (NF, 1.0D0, XU)
        IF (RPAR(6).EQ.0.0D0) IPAR(4)=1
        RPAR(1)=0.0D0
        IF (NEXT.EQ.5) RPAR(1)=1.0D1
        IF (NEXT.EQ.10) RPAR(1)=1.0D0
        IF (NEXT.EQ.12) RPAR(1)=1.0D0
!
!     SOLUTION
!
        CALL PSECS (NF, NA, MA, X, IX, XL, XU, AF, IAG, JAG, IPAR, RPAR,
     &    F, GMAX, ISPAS, IPRNT, ITERM)
        NITER=NITER+NIT
        NFVAL=NFVAL+NFV
        NITCG=NITCG+NIN
        IF (ITERM.GT.0.AND.ITERM.LT.9) NSUCC=NSUCC+1
   30 CONTINUE
      WRITE (6,40) NITER,NFVAL,NFVAL,NITCG,NSUCC
   40 FORMAT (' NITER =',I5,3X,' NFVAL =',I5,3X,' NGVAL =',I5,3X,' NITCG
     & =',I5,3X,' NSUCC =',I5)
      CALL TYTIM2 (ITIME)
      STOP
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF FA)
!
      SUBROUTINE FUN (NF, KA, X, FA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),FA
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     FUNCTION EVALUATION
!
      CALL TAFU14 (NF, KA, X, FA, NEXT)
      RETURN
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF GA)
!
      SUBROUTINE DFUN (NF, KA, X, GA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),GA(*)
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     GRADIENT EVALUATION
!
      CALL TAGU14 (NF, KA, X, GA, NEXT)
      RETURN
      END
!     EMPTY SUBROUTINES
!
      SUBROUTINE OBJ (NF, X, FF)
      INTEGER NF
      DOUBLE PRECISION X(*),FF
      NF=1
      FF=X(1)
      END
      SUBROUTINE DOBJ (NF, X, GF)
      INTEGER NF
      DOUBLE PRECISION X(*),GF(*)
      NF=1
      GF(1)=X(1)
      RETURN
      END
!     TEST PROGRAM FOR THE SUBROUTINE PSECU
!
      INTEGER NF,NA,MA,IAG(2001),JAG(8000),IPAR(7),ISPAS,IPRNT,ITERM
      DOUBLE PRECISION X(1000),AF(2000),RPAR(9),F,GMAX
      INTEGER NEXT,IERR,I,ITIME
      INTEGER NITER,NFVAL,NSUCC,NITCG
      COMMON /PROB/ NEXT
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      NITER=0
      NFVAL=0
      NSUCC=0
      NITCG=0
      CALL TYTIM1 (ITIME)
!
!     LOOP FOR 22 TEST PROBLEMS
!
      DO 30 NEXT=1,22
!
!     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
        ISPAS=2
        IPRNT=1
!
!     PROBLEM DIMENSION
!
        NF=1000
        NA=2000
!
!     INITIATION OF X AND CHOICE OF RPAR(1) AND RPAR(6)
!
        CALL TIUB14 (NF, NA, MA, X, IAG, JAG, RPAR(6), RPAR(1), NEXT,
     &   IERR)
        IF (IERR.NE.0) GO TO 30
        IF (RPAR(6).EQ.0.0D0) IPAR(4)=1
        RPAR(1)=0.0D0
        IF (NEXT.EQ.10) RPAR(1)=1.0D1
        IF (NEXT.EQ.11) RPAR(1)=2.0D2
        IF (NEXT.EQ.12) RPAR(1)=1.0D1
!
!     SOLUTION
!
        CALL PSECU (NF, NA, MA, X, AF, IAG, JAG, IPAR, RPAR, F, GMAX,
     &   ISPAS, IPRNT, ITERM)
        NITER=NITER+NIT
        NFVAL=NFVAL+NFV
        NITCG=NITCG+NIN
        IF (ITERM.GT.0.AND.ITERM.LT.9) NSUCC=NSUCC+1
   30 CONTINUE
      WRITE (6,40) NITER,NFVAL,NFVAL,NITCG,NSUCC
   40 FORMAT (' NITER =',I5,3X,' NFVAL =',I5,3X,' NGVAL =',I5,3X,' NITCG
     & =',I5,3X,' NSUCC =',I5)
      CALL TYTIM2 (ITIME)
      STOP
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF FA)
!
      SUBROUTINE FUN (NF, KA, X, FA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),FA
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     FUNCTION EVALUATION
!
      CALL TAFU14 (NF, KA, X, FA, NEXT)
      RETURN
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF GA)
!
      SUBROUTINE DFUN (NF, KA, X, GA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),GA(*)
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     GRADIENT EVALUATION
!
      CALL TAGU14 (NF, KA, X, GA, NEXT)
      RETURN
      END
!     EMPTY SUBROUTINES
!
      SUBROUTINE OBJ (NF, X, FF)
      INTEGER NF
      DOUBLE PRECISION X(*),FF
      NF=1
      FF=X(1)
      END
      SUBROUTINE DOBJ (NF, X, GF)
      INTEGER NF
      DOUBLE PRECISION X(*),GF(*)
      NF=1
      GF(1)=X(1)
      RETURN
      END
!     TEST PROGRAM FOR THE SUBROUTINE PSEDS
!
      INTEGER NF,NA,MA,IX(1000),IAG(2001),JAG(8000),IPAR(7),ISPAS,IPRNT,
     &ITERM
      DOUBLE PRECISION X(1000),XL(1000),XU(1000),AF(2000),RPAR(9),F,
     &GMAX
      INTEGER NEXT,IERR,I,ITIME
      INTEGER NITER,NFVAL,NSUCC
      COMMON /PROB/ NEXT
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      NITER=0
      NFVAL=0
      NSUCC=0
      CALL TYTIM1 (ITIME)
!
!     LOOP FOR 22 TEST PROBLEMS
!
      DO 30 NEXT=1,22
!
!     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
        ISPAS=2
        IPRNT=1
!
!     PROBLEM DIMENSION
!
        NF=1000
        NA=2000
!
!     INITIATION OF X AND CHOICE OF RPAR(1) AND RPAR(6)
!
        CALL TIUB14 (NF, NA, MA, X, IAG, JAG, RPAR(6), RPAR(1), NEXT,
     &   IERR)
        IF (IERR.NE.0) GO TO 30
        CALL MXVINS (NF, 3, IX)
        CALL MXVSET (NF, -1.0D0, XL)
        CALL MXVSET (NF, 1.0D0, XU)
        IF (RPAR(6).EQ.0.0D0) IPAR(4)=1
        RPAR(1)=0.0D0
        IF (NEXT.EQ.5) RPAR(1)=1.0D1
        IF (NEXT.EQ.10) RPAR(1)=1.0D0
        IF (NEXT.EQ.12) RPAR(1)=1.0D0
!
!     SOLUTION
!
        CALL PSEDS (NF, NA, MA, X, IX, XL, XU, AF, IAG, JAG, IPAR, RPAR,
     &    F, GMAX, ISPAS, IPRNT, ITERM)
        NITER=NITER+NIT
        NFVAL=NFVAL+NFV
        IF (ITERM.GT.0.AND.ITERM.LT.9) NSUCC=NSUCC+1
   30 CONTINUE
      WRITE (6,40) NITER,NFVAL,NFVAL,NSUCC
   40 FORMAT (' NITER =',I5,3X,' NFVAL =',I5,3X,' NGVAL =',I5,3X,' NSUCC
     & =',I5)
      CALL TYTIM2 (ITIME)
      STOP
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF FA)
!
      SUBROUTINE FUN (NF, KA, X, FA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),FA
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     FUNCTION EVALUATION
!
      CALL TAFU14 (NF, KA, X, FA, NEXT)
      RETURN
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF GA)
!
      SUBROUTINE DFUN (NF, KA, X, GA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),GA(*)
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     GRADIENT EVALUATION
!
      CALL TAGU14 (NF, KA, X, GA, NEXT)
      RETURN
      END
!     EMPTY SUBROUTINES
!
      SUBROUTINE OBJ (NF, X, FF)
      INTEGER NF
      DOUBLE PRECISION X(*),FF
      NF=1
      FF=X(1)
      END
      SUBROUTINE DOBJ (NF, X, GF)
      INTEGER NF
      DOUBLE PRECISION X(*),GF(*)
      NF=1
      GF(1)=X(1)
      RETURN
      END
!     TEST PROGRAM FOR THE SUBROUTINE PSEDU
!
      INTEGER NF,NA,MA,IAG(2001),JAG(8000),IPAR(7),ISPAS,IPRNT,ITERM
      DOUBLE PRECISION X(1000),AF(2000),RPAR(9),F,GMAX
      INTEGER NEXT,IERR,I,ITIME
      INTEGER NITER,NFVAL,NSUCC
      COMMON /PROB/ NEXT
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      NITER=0
      NFVAL=0
      NSUCC=0
      CALL TYTIM1 (ITIME)
!
!     LOOP FOR 22 TEST PROBLEMS
!
      DO 30 NEXT=1,22
!
!     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
        ISPAS=2
        IPRNT=1
!
!     PROBLEM DIMENSION
!
        NF=1000
        NA=2000
!
!     INITIATION OF X AND CHOICE OF RPAR(1) AND RPAR(6)
!
        CALL TIUB14 (NF, NA, MA, X, IAG, JAG, RPAR(6), RPAR(1), NEXT,
     &   IERR)
        IF (IERR.NE.0) GO TO 30
        IF (RPAR(6).EQ.0.0D0) IPAR(4)=1
        RPAR(1)=0.0D0
        IF (NEXT.EQ.10) RPAR(1)=1.0D1
        IF (NEXT.EQ.11) RPAR(1)=2.0D2
        IF (NEXT.EQ.12) RPAR(1)=1.0D1
!
!     SOLUTION
!
        CALL PSEDU (NF, NA, MA, X, AF, IAG, JAG, IPAR, RPAR, F, GMAX,
     &   ISPAS, IPRNT, ITERM)
        NITER=NITER+NIT
        NFVAL=NFVAL+NFV
        IF (ITERM.GT.0.AND.ITERM.LT.9) NSUCC=NSUCC+1
   30 CONTINUE
      WRITE (6,40) NITER,NFVAL,NFVAL,NSUCC
   40 FORMAT (' NITER =',I5,3X,' NFVAL =',I5,3X,' NGVAL =',I5,3X,' NSUCC
     & =',I5)
      CALL TYTIM2 (ITIME)
      STOP
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF FA)
!
      SUBROUTINE FUN (NF, KA, X, FA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),FA
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     FUNCTION EVALUATION
!
      CALL TAFU14 (NF, KA, X, FA, NEXT)
      RETURN
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF GA)
!
      SUBROUTINE DFUN (NF, KA, X, GA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),GA(*)
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     GRADIENT EVALUATION
!
      CALL TAGU14 (NF, KA, X, GA, NEXT)
      RETURN
      END
!     EMPTY SUBROUTINES
!
      SUBROUTINE OBJ (NF, X, FF)
      INTEGER NF
      DOUBLE PRECISION X(*),FF
      NF=1
      FF=X(1)
      END
      SUBROUTINE DOBJ (NF, X, GF)
      INTEGER NF
      DOUBLE PRECISION X(*),GF(*)
      NF=1
      GF(1)=X(1)
      RETURN
      END
!     TEST PROGRAM FOR THE SUBROUTINE PSENU
!
      INTEGER NF,NA,MA,IAG(6001),JAG(20000),IPAR(7),ISPAS,IPRNT,ITERM
      DOUBLE PRECISION X(1000),AF(6000),RPAR(9),F,GMAX
      INTEGER NEXT,IERR,I,ITIME
      INTEGER NITER,NFVAL,NSUCC
      DOUBLE PRECISION FB
      COMMON /PROB/ FB,NEXT
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      NITER=0
      NFVAL=0
      NSUCC=0
      CALL TYTIM1 (ITIME)
!
!     LOOP FOR 22 TEST PROBLEMS
!
      DO 30 NEXT=1,22
!
!     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
        ISPAS=2
        IPRNT=1
!
!     PROBLEM DIMENSION
!
        NF=200
        NA=6000
!
!     INITIATION OF X AND CHOICE OF RPAR(1) AND RPAR(6)
!
        CALL TIUB15 (NF, NA, MA, X, IAG, JAG, RPAR(6), RPAR(1), NEXT,
     &    IERR)
        IF (IERR.NE.0) GO TO 30
        RPAR(1)=0.0D0
        IF (NEXT.EQ.1) RPAR(9)=1.0D1
        IF (NEXT.EQ.2) RPAR(9)=5.0D0
        IF (NEXT.EQ.2) RPAR(1)=5.0D1
        IF (NEXT.EQ.4) RPAR(1)=1.0D1
        IF (NEXT.EQ.3) RPAR(1)=1.0D1
        IF (NEXT.EQ.5) RPAR(1)=1.0D0
        IF (NEXT.EQ.7) RPAR(9)=1.0D-16
        IF (NEXT.EQ.8) RPAR(1)=1.0D0
        IF (NEXT.EQ.9) RPAR(9)=1.0D-16
        IF (NEXT.EQ.9) RPAR(1)=1.0D1
        IF (NEXT.EQ.10) RPAR(1)=1.0D0
        IF (NEXT.EQ.11) RPAR(9)=1.0D-16
        IF (NEXT.EQ.11) RPAR(1)=1.51D1
        IF (NEXT.EQ.12) RPAR(9)=5.0D0
        IF (NEXT.EQ.12) RPAR(1)=1.0D1
        IF (NEXT.EQ.13) RPAR(9)=1.0D-16
        IF (NEXT.EQ.13) RPAR(1)=1.0D1
        IF (NEXT.EQ.14) RPAR(1)=1.0D1
        IF (NEXT.EQ.15) RPAR(1)=5.0D-1
        IF (NEXT.EQ.16) RPAR(1)=1.0D0
        IF (NEXT.EQ.17) RPAR(9)=1.0D-4
        IF (NEXT.EQ.18) RPAR(9)=5.5D-1
        IF (NEXT.EQ.18) RPAR(1)=8.5D1
        IF (NEXT.EQ.19) RPAR(1)=1.0D2
        IF (NEXT.EQ.21) RPAR(1)=1.0D1
        IF (NEXT.EQ.22) RPAR(1)=2.0D1
!
!     SOLUTION
!
        CALL PSENU (NF, NA, MA, X, AF, IAG, JAG, IPAR, RPAR, F, GMAX,
     &   ISPAS, IPRNT, ITERM)
        NITER=NITER+NIT
        NFVAL=NFVAL+NFV
        IF (ITERM.GT.0.AND.ITERM.LT.9) NSUCC=NSUCC+1
   30 CONTINUE
      WRITE (6,40) NITER,NFVAL,NFVAL,NSUCC
   40 FORMAT (' NITER =',I5,3X,' NFVAL =',I5,3X,' NGVAL =',I5,3X,' NSUCC
     & =',I5)
      CALL TYTIM2 (ITIME)
      STOP
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF FA)
!
      SUBROUTINE FUN (NF, KA, X, FA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),FA
      INTEGER NEXT
      DOUBLE PRECISION FB
      COMMON /PROB/ FB,NEXT
!
!     FUNCTION EVALUATION
!
      CALL TAFU15 (NF, KA, X, FB, NEXT)
      FA=ABS(FB)
      RETURN
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF GA)
!
      SUBROUTINE DFUN (NF, KA, X, GA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),GA(*)
      INTEGER NEXT
      DOUBLE PRECISION FB
      COMMON /PROB/ FB,NEXT
!
!     GRADIENT EVALUATION
!
      IF (FB.LT.0) CALL MXVSET (NF, 0.0D0, GA)
      CALL TAGU15 (NF, KA, X, GA, NEXT)
      IF (FB.LT.0) CALL MXVNEG (NF, GA, GA)
      RETURN
      END
!     EMPTY SUBROUTINES
!
      SUBROUTINE OBJ (NF, X, FF)
      INTEGER NF
      DOUBLE PRECISION X(*),FF
      NF=1
      FF=X(1)
      END
      SUBROUTINE DOBJ (NF, X, GF)
      INTEGER NF
      DOUBLE PRECISION X(*),GF(*)
      NF=1
      GF(1)=X(1)
      RETURN
      END
!     TEST PROGRAM FOR THE SUBROUTINE PSUMU
!
      INTEGER NF,NA,MA,IAG(6001),JAG(20000),IPAR(7),ISPAS,IPRNT,ITERM
      DOUBLE PRECISION X(1000),AF(6000),RPAR(9),F,GMAX
      INTEGER NEXT,IERR,I,ITIME
      INTEGER NITER,NFVAL,NGVAL,NSUCC
      COMMON /PROB/ NEXT
      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
      NITER=0
      NFVAL=0
      NGVAL=0
      NSUCC=0
      CALL TYTIM1 (ITIME)
!
!     LOOP FOR 22 TEST PROBLEMS
!
      DO 30 NEXT=1,22
!
!     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
        ISPAS=2
        IPRNT=1
        IF (NEXT.EQ.9) IPAR(5)=2
!
!     PROBLEM DIMENSION
!
        NF=200
        NA=6000
!
!     INITIATION OF X AND CHOICE OF RPAR(1) AND RPAR(6)
!
        CALL TIUB15 (NF, NA, MA, X, IAG, JAG, RPAR(6), RPAR(1), NEXT,
     &    IERR)
        IF (IERR.NE.0) GO TO 30
        IF (IPAR(5).LE.1) THEN
          IF (NEXT.EQ.2) RPAR(1)=3.5D0
          IF (NEXT.EQ.7) RPAR(1)=1.5D1
          IF (NEXT.EQ.9) RPAR(1)=8.0D0
          IF (NEXT.EQ.12) RPAR(1)=9.0D0
          IF (NEXT.EQ.13) RPAR(1)=8.0D0
          IF (next.eq.15) RPAR(1)=5.0d0
          IF (NEXT.EQ.18) RPAR(1)=1.5D1
        ELSE
          IF (NEXT.EQ.1) RPAR(1)=5.0D0
          IF (NEXT.EQ.2) RPAR(1)=1.6D1
          IF (NEXT.EQ.7) RPAR(1)=3.8D1
          IF (NEXT.EQ.9) RPAR(1)=2.2d1
          IF (NEXT.EQ.10) RPAR(1)=8.7D1
          IF (NEXT.EQ.12) RPAR(1)=1.2D1
          IF (NEXT.EQ.13) RPAR(1)=7.0D0
          IF (NEXT.EQ.18) RPAR(1)=1.5D1
        END IF
!
!     SOLUTION
!
        CALL PSUMU (NF, NA, MA, X, AF, IAG, JAG, IPAR, RPAR, F, GMAX,
     &   ISPAS, IPRNT, ITERM)
        NITER=NITER+NIT
        NFVAL=NFVAL+NFV
        NGVAL=NGVAL+NFG
        IF (ITERM.GT.0.AND.ITERM.LE.10) NSUCC=NSUCC+1
   30 CONTINUE
      WRITE (6,40) NITER,NFVAL,NGVAL,NSUCC
   40 FORMAT (' NITER =',I5,3X,' NFVAL =',I5,3X,' NGVAL =',I5,3X,' NSUCC
     & =',I5)
      CALL TYTIM2 (ITIME)
      STOP
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF FA)
!
      SUBROUTINE FUN (NF, KA, X, FA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),FA
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     FUNCTION EVALUATION
!
      CALL TAFU15 (NF, KA, X, FA, NEXT)
      RETURN
      END
!     USER SUPPLIED SUBROUTINE (CALCULATION OF GA)
!
      SUBROUTINE DFUN (NF, KA, X, GA)
      INTEGER NF,KA
      DOUBLE PRECISION X(*),GA(*)
      INTEGER NEXT
      COMMON /PROB/ NEXT
!
!     GRADIENT EVALUATION
!
      CALL TAGU15 (NF, KA, X, GA, NEXT)
      RETURN
      END
!     EMPTY SUBROUTINES
!
      SUBROUTINE OBJ (NF, X, FF)
      INTEGER NF
      DOUBLE PRECISION X(*),FF
      NF=1
      FF=X(1)
      END
      SUBROUTINE DOBJ (NF, X, GF)
      INTEGER NF
      DOUBLE PRECISION X(*),GF(*)
      NF=1
      GF(1)=X(1)
      RETURN
      END
! SUBROUTINE TIUB14                ALL SYSTEMS                99/12/01
! PORTABILITY : ALL SYSTEMS
! 92/12/01 RA : ORIGINAL VERSION
!
! PURPOSE :
!  INITIAL VALUES OF THE VARIABLES AND STRUCTURE OF THE SPARSE HESSIAN
!  MATRIX FOR UNCONSTRAINED MINIMIZATION.
!  SPARSE VERSION WITH CHANGED TESTS 7-10, 12.
!  CHANGED FOR THE TESTS.
!
! PARAMETERS :
!  II  N  NUMBER OF VARIABLES.
!  II  NB  NUMBER OF ELEMENTS OF THE SPARSE MATRIX.
!  RO  X(N)  VECTOR OF VARIABLES.
!  IO  IH(N+1)  POINTERS OF THE DIAGONAL ELEMENTS OF THE HESSIAN MATRIX.
!  IO  JH(M)  INDICES OF THE NONZERO ELEMENTS OF THE HESSIAN MATRIX IN
!             THE PACKED ROW.
!  II  NEXT  NUMBER OF THE TEST PROBLEM.
!  IO  IERR  ERROR INDICATOR.
!
      SUBROUTINE TIUB14 (N, NB, MB, X, IH, JH, FMIN, XMAX, NEXT, IERR)
      INTEGER N,NB,MB,NEXT,IERR
      INTEGER IH(*),JH(*)
      DOUBLE PRECISION X(N),FMIN,XMAX
      DOUBLE PRECISION P,Q
      INTEGER I,J,K
      DOUBLE PRECISION ETA9
      PARAMETER  (ETA9=1.0D60)
      FMIN=0.0D0
      XMAX=1.0D3
      IERR=0
      GO TO (10,50,90,110,130,170,200,240,280,300,320,350,370,390,410,
     &430,450,470,490,510,530,550),NEXT
   10 IF (N.LT.2) GO TO 570
      N=N-MOD(N,2)
      DO 20 I=1,N
        IF (MOD(I,2).EQ.1) THEN
          X(I)=-1.2D0
        ELSE
          X(I)=1.0D0
        END IF
   20 CONTINUE
   30 NB=N-1
      DO 40 I=1,NB
        J=2*(I-1)+1
        JH(J)=I
        JH(J+1)=I+1
        IH(I)=J
   40 CONTINUE
      MB=2*NB
      IH(NB+1)=MB+1
      RETURN
   50 IF (N.LT.4) GO TO 570
      N=N-MOD(N,2)
      DO 60 I=1,N
        IF (MOD(I,2).EQ.1) THEN
          X(I)=-2.0D0
          IF (I.LE.4) X(I)=-3.0D0
        ELSE
          X(I)=0.0D0
          IF (I.LE.4) X(I)=-1.0D0
        END IF
   60 CONTINUE
   70 NB=(N-2)/2
      DO 80 I=1,NB
        J=4*(I-1)+1
        K=2*I-1
        JH(J)=K
        JH(J+1)=K+1
        JH(J+2)=K+2
        JH(J+3)=K+3
        IH(I)=J
   80 CONTINUE
      MB=4*NB
      IH(NB+1)=IH(NB)+4
      RETURN
   90 IF (N.LT.4) GO TO 570
      N=N-MOD(N,2)
      DO 100 I=1,N
        IF (MOD(I,4).EQ.1) THEN
          X(I)=3.0D0
        ELSE IF (MOD(I,4).EQ.2) THEN
          X(I)=-1.0D0
        ELSE IF (MOD(I,4).EQ.3) THEN
          X(I)=0.0D0
        ELSE
          X(I)=1.0D0
        END IF
  100 CONTINUE
      GO TO 70
  110 IF (N.LT.4) GO TO 570
      N=N-MOD(N,2)
      DO 120 I=1,N
        X(I)=2.0D0
  120 CONTINUE
      X(1)=1.0D0
!      XMAX=1.0D 1
      GO TO 70
  130 IF (N.LT.3) GO TO 570
      DO 140 I=1,N
        X(I)=-1.0D0
  140 CONTINUE
  150 MB=1
      NB=N
      DO 160 I=1,NB
        IH(I)=MB
        IF (I.GT.1) THEN
          JH(MB)=I-1
          MB=MB+1
        END IF
        JH(MB)=I
        MB=MB+1
        IF (I.LT.N) THEN
          JH(MB)=I+1
          MB=MB+1
        END IF
  160 CONTINUE
      IH(NB+1)=MB
      MB=MB-1
      RETURN
  170 IF (N.LT.7) GO TO 570
      DO 180 I=1,N
        X(I)=-1.0D0
  180 CONTINUE
      MB=1
      NB=N
      DO 190 I=1,NB
        IH(I)=MB
        IF (I.GT.5) THEN
          JH(MB)=I-5
          MB=MB+1
        END IF
        IF (I.GT.4) THEN
          JH(MB)=I-4
          MB=MB+1
        END IF
        IF (I.GT.3) THEN
          JH(MB)=I-3
          MB=MB+1
        END IF
        IF (I.GT.2) THEN
          JH(MB)=I-2
          MB=MB+1
        END IF
        IF (I.GT.1) THEN
          JH(MB)=I-1
          MB=MB+1
        END IF
        JH(MB)=I
        MB=MB+1
        IF (I.LT.N) THEN
          JH(MB)=I+1
          MB=MB+1
        END IF
  190 CONTINUE
      IH(NB+1)=MB
      MB=MB-1
      RETURN
  200 IF (N.LT.4) GO TO 570
      N=N-MOD(N,2)
      DO 210 I=1,N
        X(I)=-1.0D0
  210 CONTINUE
      MB=1
      K=N/2
      NB=N+K
      DO 220 I=1,N
        IH(I)=MB
        IF (I.GT.1) THEN
          JH(MB)=I-1
          MB=MB+1
        END IF
        JH(MB)=I
        MB=MB+1
        IF (I.LT.N) THEN
          JH(MB)=I+1
          MB=MB+1
        END IF
  220 CONTINUE
      DO 230 I=1,K
        IH(N+I)=MB
        JH(MB)=I
        MB=MB+1
        JH(MB)=I+K
        MB=MB+1
  230 CONTINUE
      IH(NB+1)=MB
      MB=MB-1
      RETURN
  240 IF (N.LT.6) GO TO 570
      DO 250 I=1,N
        X(I)=1.0D0/DBLE(N)
  250 CONTINUE
  260 MB=1
      NB=N
      K=N/2
      DO 270 I=1,NB
        IH(I)=MB
        IF (I.GT.K) THEN
          JH(MB)=I-K
          MB=MB+1
        END IF
        IF (I.GT.2) THEN
          JH(MB)=I-2
          MB=MB+1
        END IF
        IF (I.GT.1) THEN
          JH(MB)=I-1
          MB=MB+1
        END IF
        JH(MB)=I
        MB=MB+1
        IF (I.LT.N) THEN
          JH(MB)=I+1
          MB=MB+1
        END IF
        IF (I.LT.N-1) THEN
          JH(MB)=I+2
          MB=MB+1
        END IF
        IF (I.LE.K) THEN
          JH(MB)=I+K
          MB=MB+1
        END IF
  270 CONTINUE
      IH(NB+1)=MB
      MB=MB-1
      RETURN
  280 IF (N.LT.6) GO TO 570
      DO 290 I=1,N
        X(I)=1.0D0/DBLE(N)
  290 CONTINUE
      FMIN=-ETA9
      GO TO 260
  300 IF (N.LT.6) GO TO 570
      DO 310 I=1,N
        X(I)=1.0D0
  310 CONTINUE
      FMIN=-ETA9
      GO TO 260
  320 IF (N.LT.5) GO TO 570
      N=N-MOD(N,5)
      DO 330 I=0,N-5,5
        X(I+1)=-1.0D0
        X(I+2)=-1.0D0
        X(I+3)=2.0D0
        X(I+4)=-1.0D0
        X(I+5)=-1.0D0
  330 CONTINUE
      X(1)=-2.0D0
      X(2)=2.0D0
      MB=1
      NB=N/5
      DO 340 I=1,NB
        J=5*(I-1)+1
        IH(I)=MB
        MB=MB+5
        JH(MB-5)=J
        JH(MB-4)=J+1
        JH(MB-3)=J+2
        JH(MB-2)=J+3
        JH(MB-1)=J+4
  340 CONTINUE
      IH(NB+1)=MB
      MB=MB-1
      XMAX=1.0D1
      RETURN
  350 IF (N.LT.2) GO TO 570
      N=N-MOD(N,2)
      DO 360 I=2,N,2
        X(I-1)=0.0D0
        X(I)=-1.0D0
  360 CONTINUE
      XMAX=1.0D1
      GO TO 30
  370 IF (N.LT.2) GO TO 570
      N=N-MOD(N,2)
      DO 380 I=2,N,2
        X(I-1)=-1.0D0
        X(I)=1.0D0
  380 CONTINUE
!      XMAX=1.0D 0
      GO TO 30
  390 IF (N.LT.3) GO TO 570
      P=1.0D0/DBLE(N+1)
      DO 400 I=1,N
        Q=P*DBLE(I)
        X(I)=Q*(Q-1.0D0)
  400 CONTINUE
!      XMAX=1.0D 1
      GO TO 150
  410 IF (N.LT.2) GO TO 570
      P=1.0D0/DBLE(N+1)
      DO 420 I=1,N
        X(I)=DBLE(I)*DBLE(N+1-I)*P**2
  420 CONTINUE
      FMIN=-ETA9
!      XMAX=1.0D 1
      GO TO 30
  430 IF (N.LT.3) GO TO 570
      DO 440 I=1,N
        X(I)=1.0D0
  440 CONTINUE
      FMIN=-ETA9
      GO TO 150
  450 IF (N.LT.3) GO TO 570
      P=1.0D0/DBLE(N+1)
      DO 460 I=1,N
        X(I)=DBLE(I)*DBLE(N+1-I)*P**2
  460 CONTINUE
      FMIN=-ETA9
      GO TO 150
  470 IF (N.LT.3) GO TO 570
      P=1.0D0/DBLE(N+1)
      DO 480 I=1,N
        X(I)=DBLE(I)*DBLE(N+1-I)*P**2
  480 CONTINUE
      FMIN=-ETA9
      GO TO 150
  490 IF (N.LT.3) GO TO 570
      P=EXP(2.0D0)/DBLE(N+1)
      DO 500 I=1,N
        X(I)=(P*DBLE(I)+1.0D0)/3.0D0
  500 CONTINUE
      FMIN=-ETA9
      GO TO 150
  510 IF (N.LT.3) GO TO 570
      P=1.0D0/DBLE(N+1)
      DO 520 I=1,N
        X(I)=P*DBLE(I)
  520 CONTINUE
      FMIN=-ETA9
      GO TO 150
  530 IF (N.LT.3) GO TO 570
      P=1.0D0/DBLE(N+1)
      DO 540 I=1,N
        X(I)=P*DBLE(I)+1.0D0
  540 CONTINUE
      FMIN=-ETA9
      GO TO 150
  550 IF (N.LT.3) GO TO 570
      P=1.0D0/DBLE(N+1)
      DO 560 I=1,N
        X(I)=DBLE(I)*DBLE(N+1-I)*P**2
  560 CONTINUE
      FMIN=-ETA9
      GO TO 150
  570 IERR=1
      RETURN
      END
! SUBROUTINE TIUD14                ALL SYSTEMS                99/12/01
! PORTABILITY : ALL SYSTEMS
! 98/12/01 TU : ORIGINAL VERSION
!
! PURPOSE :
!  INITIAL VALUES OF THE VARIABLES AND STRUCTURE OF THE SPARSE HESSIAN
!  MATRIX FOR UNCONSTRAINED MINIMIZATION.
!
! PARAMETERS :
!  II  N  NUMBER OF VARIABLES.
!  RO  X(N)  VECTOR OF VARIABLES.
!  II  NEXT  NUMBER OF THE TEST PROBLEM.
!  IO  IERR  ERROR INDICATOR.
!
      SUBROUTINE TIUD14 (N, X, FMIN, XMAX, NEXT, IERR)
      INTEGER N,NEXT,IERR
      DOUBLE PRECISION X(*),FMIN,XMAX
      DOUBLE PRECISION P,Q
      INTEGER I
      DOUBLE PRECISION ETA9
      PARAMETER  (ETA9=1.0D60)
      FMIN=0.0D0
      XMAX=1.0D3
      IERR=0
      GO TO (10,30,50,70,90,110,130,150,170,190,210,230,250,270,290,310,
     &330,350,370,390,410,430),NEXT
   10 IF (N.LT.2) GO TO 450
      N=N-MOD(N,2)
      DO 20 I=1,N
        IF (MOD(I,2).EQ.1) THEN
          X(I)=-1.2D0
        ELSE
          X(I)=1.0D0
        END IF
   20 CONTINUE
      RETURN
   30 IF (N.LT.4) GO TO 450
      N=N-MOD(N,2)
      DO 40 I=1,N
        IF (MOD(I,2).EQ.1) THEN
          X(I)=-2.0D0
          IF (I.LE.4) X(I)=-3.0D0
        ELSE
          X(I)=0.0D0
          IF (I.LE.4) X(I)=-1.0D0
        END IF
   40 CONTINUE
      RETURN
   50 IF (N.LT.4) GO TO 450
      N=N-MOD(N,2)
      DO 60 I=1,N
        IF (MOD(I,4).EQ.1) THEN
          X(I)=3.0D0
        ELSE IF (MOD(I,4).EQ.2) THEN
          X(I)=-1.0D0
        ELSE IF (MOD(I,4).EQ.3) THEN
          X(I)=0.0D0
        ELSE
          X(I)=1.0D0
        END IF
   60 CONTINUE
      RETURN
   70 IF (N.LT.4) GO TO 450
      N=N-MOD(N,2)
      DO 80 I=1,N
        X(I)=2.0D0
   80 CONTINUE
      X(1)=1.0D0
      RETURN
   90 IF (N.LT.3) GO TO 450
      DO 100 I=1,N
        X(I)=-1.0D0
  100 CONTINUE
      RETURN
  110 IF (N.LT.7) GO TO 450
      DO 120 I=1,N
        X(I)=-1.0D0
  120 CONTINUE
      RETURN
  130 IF (N.LT.4) GO TO 450
      N=N-MOD(N,2)
      DO 140 I=1,N
        X(I)=-1.0D0
  140 CONTINUE
      RETURN
  150 IF (N.LT.6) GO TO 450
      DO 160 I=1,N
        X(I)=1.0D0/DBLE(N)
  160 CONTINUE
      RETURN
  170 IF (N.LT.6) GO TO 450
      DO 180 I=1,N
        X(I)=1.0D0/DBLE(N)
  180 CONTINUE
      FMIN=-ETA9
      RETURN
  190 IF (N.LT.6) GO TO 450
      DO 200 I=1,N
        X(I)=1.0D0
  200 CONTINUE
      FMIN=-ETA9
      RETURN
  210 IF (N.LT.5) GO TO 450
      N=N-MOD(N,5)
      DO 220 I=0,N-5,5
        X(I+1)=-1.0D0
        X(I+2)=-1.0D0
        X(I+3)=2.0D0
        X(I+4)=-1.0D0
        X(I+5)=-1.0D0
  220 CONTINUE
      X(1)=-2.0D0
      X(2)=2.0D0
      XMAX=1.0D0
      RETURN
  230 IF (N.LT.2) GO TO 450
      N=N-MOD(N,2)
      DO 240 I=2,N,2
        X(I-1)=0.0D0
        X(I)=-1.0D0
  240 CONTINUE
      XMAX=1.0D0
      RETURN
  250 IF (N.LT.2) GO TO 450
      N=N-MOD(N,2)
      DO 260 I=2,N,2
        X(I-1)=-1.0D0
        X(I)=1.0D0
  260 CONTINUE
      XMAX=1.0D0
      RETURN
  270 IF (N.LT.3) GO TO 450
      P=1.0D0/DBLE(N+1)
      DO 280 I=1,N
        Q=P*DBLE(I)
        X(I)=Q*(Q-1.0D0)
  280 CONTINUE
      RETURN
  290 IF (N.LT.3) GO TO 450
      P=1.0D0/DBLE(N+1)
      DO 300 I=1,N
        X(I)=DBLE(I)*DBLE(N+1-I)*P**2
  300 CONTINUE
      FMIN=-ETA9
      XMAX=1.0D1
      RETURN
  310 IF (N.LT.3) GO TO 450
      DO 320 I=1,N
        X(I)=1.0D0
  320 CONTINUE
      FMIN=-ETA9
      RETURN
  330 IF (N.LT.3) GO TO 450
      P=1.0D0/DBLE(N+1)
      DO 340 I=1,N
        X(I)=DBLE(I)*DBLE(N+1-I)*P**2
  340 CONTINUE
      FMIN=-ETA9
      RETURN
  350 IF (N.LT.3) GO TO 450
      P=1.0D0/DBLE(N+1)
      DO 360 I=1,N
        X(I)=DBLE(I)*DBLE(N+1-I)*P**2
  360 CONTINUE
      FMIN=-ETA9
      RETURN
  370 IF (N.LT.3) GO TO 450
      P=EXP(2.0D0)/DBLE(N+1)
      DO 380 I=1,N
        X(I)=(P*DBLE(I)+1.0D0)/3.0D0
  380 CONTINUE
      FMIN=-ETA9
      RETURN
  390 IF (N.LT.3) GO TO 450
      P=1.0D0/DBLE(N+1)
      DO 400 I=1,N
        X(I)=P*DBLE(I)
  400 CONTINUE
      FMIN=-ETA9
      RETURN
  410 IF (N.LT.3) GO TO 450
      P=1.0D0/DBLE(N+1)
      DO 420 I=1,N
        X(I)=P*DBLE(I)+1.0D0
  420 CONTINUE
      FMIN=-ETA9
      RETURN
  430 IF (N.LT.3) GO TO 450
      P=1.0D0/DBLE(N+1)
      DO 440 I=1,N
        X(I)=DBLE(I)*DBLE(N+1-I)*P**2
  440 CONTINUE
      FMIN=-ETA9
      RETURN
  450 IERR=1
      RETURN
      END
! SUBROUTINE TIUS14                ALL SYSTEMS                99/12/01
! PORTABILITY : ALL SYSTEMS
! 98/12/01 TU : ORIGINAL VERSION
!
! PURPOSE :
!  INITIAL VALUES OF THE VARIABLES AND STRUCTURE OF THE SPARSE HESSIAN
!  MATRIX FOR UNCONSTRAINED MINIMIZATION.
!  SPARSE VERSION WITH CHANGED TESTS 7-10, 12.
!  CHANGED FOR THE TESTS.
!
! PARAMETERS :
!  II  N  NUMBER OF VARIABLES.
!  II  M  NUMBER OF ELEMENTS OF THE SPARSE MATRIX.
!  RO  X(N)  VECTOR OF VARIABLES.
!  IO  IH(N+1)  POINTERS OF THE DIAGONAL ELEMENTS OF THE HESSIAN MATRIX.
!  IO  JH(M)  INDICES OF THE NONZERO ELEMENTS OF THE HESSIAN MATRIX IN
!             THE PACKED ROW.
!  II  NEXT  NUMBER OF THE TEST PROBLEM.
!  IO  IERR  ERROR INDICATOR.
!
      SUBROUTINE TIUS14 (N, M, X, IH, JH, FMIN, XMAX, NEXT, IERR)
      INTEGER N,M,NEXT,IERR
      INTEGER IH(*),JH(*)
      DOUBLE PRECISION X(N),FMIN,XMAX
      DOUBLE PRECISION P,Q
      INTEGER I,J,K,L,K1,K2,M1
      DOUBLE PRECISION ETA9
      PARAMETER  (ETA9=1.0D60)
      FMIN=0.0D0
      XMAX=1.0D3
      IERR=0
      GO TO (10,50,80,120,150,190,220,250,280,310,340,390,410,430,450,
     &470,490,510,530,550,570,590),NEXT
   10 IF (N.LT.2) GO TO 610
      N=N-MOD(N,2)
      DO 20 I=1,N
        IF (MOD(I,2).EQ.1) THEN
          X(I)=-1.2D0
        ELSE
          X(I)=1.0D0
        END IF
   20 CONTINUE
   30 DO 40 I=1,N-1
        J=2*(I-1)+1
        IH(I)=J
        JH(J)=I
        JH(J+1)=I+1
   40 CONTINUE
      J=2*(N-1)+1
      IH(N)=J
      JH(J)=N
      IH(N+1)=2*N
      M=2*N-1
      RETURN
   50 IF (N.LT.4) GO TO 610
      N=N-MOD(N,2)
      DO 60 I=1,N
        IF (MOD(I,2).EQ.1) THEN
          X(I)=-2.0D0
          IF (I.LE.4) X(I)=-3.0D0
        ELSE
          X(I)=0.0D0
          IF (I.LE.4) X(I)=-1.0D0
        END IF
   60 CONTINUE
      DO 70 I=1,N-1
        J=2*I-1
        IH(I)=J
        JH(J)=I
        JH(J+1)=I+1
        IF (MOD(I,2).EQ.0) JH(J+1)=JH(J+1)+1
   70 CONTINUE
      J=2*N-1
      IH(N)=J
      JH(J)=N
      M=J
      IH(N+1)=J+1
      RETURN
   80 IF (N.LT.4) GO TO 610
      N=N-MOD(N,2)
      DO 90 I=1,N
        IF (MOD(I,4).EQ.1) THEN
          X(I)=3.0D0
        ELSE IF (MOD(I,4).EQ.2) THEN
          X(I)=-1.0D0
        ELSE IF (MOD(I,4).EQ.3) THEN
          X(I)=0.0D0
        ELSE
          X(I)=1.0D0
        END IF
   90 CONTINUE
      IH(1)=1
      IH(2)=4
      JH(1)=1
      JH(2)=2
      JH(3)=4
      JH(4)=2
      JH(5)=3
      K=5
      DO 110 I=3,N-3,2
        IH(I)=IH(I-2)+5
        J=IH(I)
        DO 100 L=J,J+4
          JH(L)=JH(L-5)+2
          K=K+1
  100   CONTINUE
        IH(I+1)=IH(I-1)+5
  110 CONTINUE
      IH(N-1)=IH(N-3)+5
      IH(N)=IH(N-2)+4
      IH(N+1)=IH(N)+1
      JH(K+1)=JH(K)
      JH(K+2)=JH(K)+1
      JH(K+3)=JH(K+2)
      M=IH(N)
      RETURN
  120 IF (N.LT.4) GO TO 610
      N=N-MOD(N,2)
      DO 130 I=1,N
        X(I)=2.0D0
  130 CONTINUE
      X(1)=1.0D0
      DO 140 I=1,N-1
        IH(I)=2*I-1
        J=IH(I)
        JH(J)=I
        JH(J+1)=I+1
  140 CONTINUE
      IH(N)=2*N-1
      JH(J+2)=JH(J+1)
      IH(N+1)=2*N
      M=IH(N)
      RETURN
  150 IF (N.LT.3) GO TO 610
      DO 160 I=1,N
        X(I)=-1.0D0
  160 CONTINUE
  170 DO 180 I=1,N-2
        J=1+3*(I-1)
        IH(I)=J
        JH(J)=I
        JH(J+1)=I+1
        JH(J+2)=I+2
  180 CONTINUE
      J=3*(N-2)+1
      IH(N-1)=J
      JH(J)=N-1
      JH(J+1)=N
      J=IH(N-1)+2
      IH(N)=J
      JH(J)=N
      IH(N+1)=IH(N)+1
      M=3*N-3
      RETURN
  190 IF (N.LT.7) GO TO 610
      DO 200 I=1,N
        X(I)=-1.0D0
  200 CONTINUE
      DO 210 I=1,N-6
        J=7*(I-1)+1
        IH(I)=J
        JH(J)=I
        JH(J+1)=I+1
        JH(J+2)=I+2
        JH(J+3)=I+3
        JH(J+4)=I+4
        JH(J+5)=I+5
        JH(J+6)=I+6
  210 CONTINUE
      J=7*(N-6)+1
      IH(N-5)=J
      JH(J)=N-5
      JH(J+1)=N-4
      JH(J+2)=N-3
      JH(J+3)=N-2
      JH(J+4)=N-1
      JH(J+5)=N
      IH(N-4)=J+6
      JH(J+6)=N-4
      JH(J+7)=N-3
      JH(J+8)=N-2
      JH(J+9)=N-1
      JH(J+10)=N
      IH(N-3)=J+11
      JH(J+11)=N-3
      JH(J+12)=N-2
      JH(J+13)=N-1
      JH(J+14)=N
      IH(N-2)=J+15
      JH(J+15)=N-2
      JH(J+16)=N-1
      JH(J+17)=N
      IH(N-1)=J+18
      JH(J+18)=N-1
      JH(J+19)=N
      IH(N)=J+20
      JH(J+20)=N
      IH(N+1)=J+21
      M=J+20
      RETURN
  220 IF (N.LT.4) GO TO 610
      N=N-MOD(N,2)
      DO 230 I=1,N
        X(I)=-1.0D0
  230 CONTINUE
      M=0
      K=N/2
      IH(1)=1
      DO 240 I=1,N
        M=M+1
        JH(M)=I
        IF (I.LT.N) THEN
          M=M+1
          JH(M)=I+1
        END IF
        IF (I.LE.K) THEN
          M=M+1
          JH(M)=I+K
        END IF
        IH(I+1)=M+1
  240 CONTINUE
      RETURN
  250 IF (N.LT.10) GO TO 610
      DO 260 I=1,N
        X(I)=1.0D0/DBLE(N)
  260 CONTINUE
      M=0
      K=N/2
      IH(1)=1
      DO 270 I=1,N
        M=M+1
        JH(M)=I
        IF (I+1.LE.N) THEN
          M=M+1
          JH(M)=I+1
        END IF
        IF (I+2.LE.N) THEN
          M=M+1
          JH(M)=I+2
        END IF
        IF (I+3.LE.N) THEN
          M=M+1
          JH(M)=I+3
        END IF
        IF (I+4.LE.N) THEN
          M=M+1
          JH(M)=I+4
        END IF
        IF (I+K-2.LE.N) THEN
          M=M+1
          JH(M)=I+K-2
        END IF
        IF (I+K-1.LE.N) THEN
          M=M+1
          JH(M)=I+K-1
        END IF
        IF (I+K.LE.N) THEN
          M=M+1
          JH(M)=I+K
        END IF
        IF (I+K+1.LE.N) THEN
          M=M+1
          JH(M)=I+K+1
        END IF
        IF (I+K+2.LE.N) THEN
          M=M+1
          JH(M)=I+K+2
        END IF
        IH(I+1)=M+1
  270 CONTINUE
      RETURN
  280 IF (N.LT.4) GO TO 610
      DO 290 I=1,N
        X(I)=1.0D0/DBLE(N)
  290 CONTINUE
      FMIN=-ETA9
      M=0
      K=N/2
      IH(1)=1
      DO 300 I=1,N
        M=M+1
        JH(M)=I
        IH(I+1)=M+1
  300 CONTINUE
      RETURN
  310 IF (N.LT.10) GO TO 610
      DO 320 I=1,N
        X(I)=1.0D0
  320 CONTINUE
      FMIN=-ETA9
      M=0
      K=N/2
      IH(1)=1
      DO 330 I=1,N
        M=M+1
        JH(M)=I
        IF (I.LT.N) THEN
          M=M+1
          JH(M)=I+1
        END IF
        IF (I.LT.N-1) THEN
          M=M+1
          JH(M)=I+2
        END IF
        IF (I.LE.K) THEN
          M=M+1
          JH(M)=I+K
        END IF
        IH(I+1)=M+1
  330 CONTINUE
      RETURN
  340 IF (N.LT.5) GO TO 610
      N=N-MOD(N,5)
      DO 350 I=0,N-5,5
        X(I+1)=-1.0D0
        X(I+2)=-1.0D0
        X(I+3)=2.0D0
        X(I+4)=-1.0D0
        X(I+5)=-1.0D0
  350 CONTINUE
      X(1)=-2.0D0
      X(2)=2.0D0
      IH(1)=1
      K=1
      DO 380 I=1,N,5
        M1=I
        K1=I
        K2=I+4
        DO 370 M=1,5
          DO 360 J=K1,K2
            JH(K)=J
            K=K+1
  360     CONTINUE
          K1=K1+1
          M1=M1+1
          IH(M1)=6-M+IH(M1-1)
  370   CONTINUE
  380 CONTINUE
      M=IH(N)
      XMAX=1.0D0
      RETURN
  390 IF (N.LT.2) GO TO 610
      N=N-MOD(N,2)
      DO 400 I=2,N,2
        X(I-1)=0.0D0
        X(I)=-1.0D0
  400 CONTINUE
      XMAX=1.0D0
      GO TO 30
  410 IF (N.LT.2) GO TO 610
      N=N-MOD(N,2)
      DO 420 I=2,N,2
        X(I-1)=-1.0D0
        X(I)=1.0D0
  420 CONTINUE
      GO TO 30
  430 IF (N.LT.3) GO TO 610
      P=1.0D0/DBLE(N+1)
      DO 440 I=1,N
        Q=P*DBLE(I)
        X(I)=Q*(Q-1.0D0)
  440 CONTINUE
      GO TO 170
  450 IF (N.LT.3) GO TO 610
      P=1.0D0/DBLE(N+1)
      DO 460 I=1,N
        X(I)=DBLE(I)*DBLE(N+1-I)*P**2
  460 CONTINUE
      FMIN=-ETA9
      XMAX=1.0D1
      GO TO 30
  470 IF (N.LT.3) GO TO 610
      DO 480 I=1,N
        X(I)=1.0D0
  480 CONTINUE
      FMIN=-ETA9
      GO TO 170
  490 IF (N.LT.3) GO TO 610
      P=1.0D0/DBLE(N+1)
      DO 500 I=1,N
        X(I)=DBLE(I)*DBLE(N+1-I)*P**2
  500 CONTINUE
      FMIN=-ETA9
      GO TO 170
  510 IF (N.LT.3) GO TO 610
      P=1.0D0/DBLE(N+1)
      DO 520 I=1,N
        X(I)=DBLE(I)*DBLE(N+1-I)*P**2
  520 CONTINUE
      FMIN=-ETA9
      GO TO 170
  530 IF (N.LT.3) GO TO 610
      P=EXP(2.0D0)/DBLE(N+1)
      DO 540 I=1,N
        X(I)=(P*DBLE(I)+1.0D0)/3.0D0
  540 CONTINUE
      FMIN=-ETA9
      GO TO 170
  550 IF (N.LT.3) GO TO 610
      P=1.0D0/DBLE(N+1)
      DO 560 I=1,N
        X(I)=P*DBLE(I)
  560 CONTINUE
      FMIN=-ETA9
      GO TO 170
  570 IF (N.LT.3) GO TO 610
      P=1.0D0/DBLE(N+1)
      DO 580 I=1,N
        X(I)=P*DBLE(I)+1.0D0
  580 CONTINUE
      FMIN=-ETA9
      GO TO 170
  590 IF (N.LT.3) GO TO 610
      P=1.0D0/DBLE(N+1)
      DO 600 I=1,N
        X(I)=DBLE(I)*DBLE(N+1-I)*P**2
  600 CONTINUE
      FMIN=-ETA9
      GO TO 170
  610 IERR=1
      RETURN
      END
! SUBROUTINE TAFU14             ALL SYSTEMS                92/12/01
! PORTABILITY : ALL SYSTEMS
! 92/12/01 RA : ORIGINAL VERSION
!
! PURPOSE :
!  VALUES OF MODEL FUNCTIONS FOR UNCONSTRAINED MINIMIZATION.
!  SPARSE VERSION - LU VERSION WITH MODIFIED TESTS NO 7-10,12.
!
! PARAMETERS :
!  II  N  NUMBER OF VARIABLES.
!  RI  X(N)  VECTOR OF VARIABLES.
!  RO  F  VALUE OF THE MODEL FUNCTION.
!  II  NEXT  NUMBER OF THE TEST PROBLEM.
!
      SUBROUTINE TAFU14 (N, KA, X, FA, NEXT)
      INTEGER N,NEXT
      DOUBLE PRECISION X(*),FA
      DOUBLE PRECISION A,B,C,D,P,Q,R,U,V
      INTEGER I,J,K,KA
      GO TO (10,20,30,40,50,60,80,90,110,130,150,170,180,190,200,210,
     &220,230,240,250,260,270),NEXT
   10 A=X(KA)**2-X(KA+1)
      B=X(KA)-1.0D0
      FA=1.0D2*A**2+B**2
      RETURN
   20 I=2*KA-1
      A=X(I)**2-X(I+1)
      B=X(I)-1.0D0
      C=X(I+2)**2-X(I+3)
      D=X(I+2)-1.0D0
      U=X(I+1)+X(I+3)-2.0D0
      V=X(I+1)-X(I+3)
      FA=1.0D2*A**2+B**2+9.0D1*C**2+D**2+1.0D1*U**2+0.1D0*V**2
      RETURN
   30 I=2*KA-1
      A=X(I)+1.0D1*X(I+1)
      B=X(I+2)-X(I+3)
      C=X(I+1)-2.0D0*X(I+2)
      D=X(I)-X(I+3)
      FA=A**2+5.0D0*B**2+C**4+1.0D1*D**4
      RETURN
   40 I=2*KA-1
      A=EXP(X(I))
      B=A-X(I+1)
      D=X(I+1)-X(I+2)
      P=X(I+2)-X(I+3)
      Q=SIN(P)/COS(P)
      U=X(I)
      V=X(I+3)-1.0D0
      FA=B**4+1.0D2*D**6+Q**4+U**8+V**2
      RETURN
   50 P=7.0D0/3.0D0
      A=(3.0D0-2.0D0*X(KA))*X(KA)+1.0D0
      IF (KA.GT.1) A=A-X(KA-1)
      IF (KA.LT.N) A=A-X(KA+1)
      FA=ABS(A)**P
      RETURN
   60 P=7.0D0/3.0D0
      A=(2.0D0+5.0D0*X(KA)**2)*X(KA)+1.0D0
      DO 70 I=MAX(1,KA-5),MIN(N,KA+1)
        A=A+X(I)*(1.0D0+X(I))
   70 CONTINUE
      FA=ABS(A)**P
      RETURN
   80 P=7.0D0/3.0D0
      IF (KA.LE.N) THEN
        A=(3.0D0-2.0D0*X(KA))*X(KA)+1.0D0
        IF (KA.GT.1) A=A-X(KA-1)
        IF (KA.LT.N) A=A-X(KA+1)
      ELSE
        I=KA-N
        A=X(I)+X(I+N/2)
      END IF
      FA=ABS(A)**P
      RETURN
   90 K=N/2
      P=0.0D0
      DO 100 I=KA-2,KA+2
        IF (I.LT.1.OR.I.GT.N) GO TO 100
        A=5.0D0*(1.0D0+MOD(I,5)+MOD(KA,5))
        B=DBLE(I+KA)/1.0D1
        P=P+A*SIN(X(I))+B*COS(X(I))
  100 CONTINUE
      IF (KA.GT.K) THEN
        I=KA-K
        A=5.0D0*(1.0D0+MOD(I,5)+MOD(KA,5))
        B=DBLE(I+KA)/1.0D1
        P=P+A*SIN(X(I))+B*COS(X(I))
      ELSE
        I=KA+K
        A=5.0D0*(1.0D0+MOD(I,5)+MOD(KA,5))
        B=DBLE(I+KA)/1.0D1
        P=P+A*SIN(X(I))+B*COS(X(I))
      END IF
      FA=(DBLE(N+KA)-P)**2/DBLE(N)
      RETURN
  110 K=N/2
      FA=DBLE(KA)*(1.0D0-COS(X(KA)))
      DO 120 I=KA-2,KA+2
        IF (I.LT.1.OR.I.GT.N) GO TO 120
        A=5.0D0*(1.0D0+MOD(I,5)+MOD(KA,5))
        B=DBLE(I+KA)/1.0D1
        FA=FA+A*SIN(X(I))+B*COS(X(I))
  120 CONTINUE
      IF (KA.GT.K) THEN
        I=KA-K
        A=5.0D0*(1.0D0+MOD(I,5)+MOD(KA,5))
        B=DBLE(I+KA)/1.0D1
        FA=FA+A*SIN(X(I))+B*COS(X(I))
      ELSE
        I=KA+K
        A=5.0D0*(1.0D0+MOD(I,5)+MOD(KA,5))
        B=DBLE(I+KA)/1.0D1
        FA=FA+A*SIN(X(I))+B*COS(X(I))
      END IF
      FA=FA/DBLE(N)
      RETURN
  130 K=N/2
      FA=0.0D0
      Q=1.0D0+DBLE(KA)/1.0D1
      DO 140 I=KA-2,KA+2
        IF (I.LT.1.OR.I.GT.N) GO TO 140
        A=5.0D0*(1.0D0+MOD(I,5)+MOD(KA,5))
        B=1.0D0+DBLE(I)/1.0D1
        C=DBLE(I+KA)/1.0D1
        FA=FA+A*SIN(Q*X(KA)+B*X(I)+C)
  140 CONTINUE
      IF (KA.GT.K) THEN
        I=KA-K
        A=5.0D0*(1.0D0+MOD(I,5)+MOD(KA,5))
        B=1.0D0+DBLE(I)/1.0D1
        C=DBLE(I+KA)/1.0D1
        FA=FA+A*SIN(Q*X(KA)+B*X(I)+C)
      ELSE
        I=KA+K
        A=5.0D0*(1.0D0+MOD(I,5)+MOD(KA,5))
        B=1.0D0+DBLE(I)/1.0D1
        C=DBLE(I+KA)/1.0D1
        FA=FA+A*SIN(Q*X(KA)+B*X(I)+C)
      END IF
      FA=FA/DBLE(N)
      RETURN
  150 P=-0.2008D-2
      Q=-0.1900D-2
      R=-0.0261D-2
      I=5*(KA-1)
      A=1.0D0
      B=0.0D0
      DO 160 J=1,5
        A=A*X(I+J)
        B=B+X(I+J)**2
  160 CONTINUE
      A=EXP(A)
      B=B-1.0D1-P
      C=X(I+2)*X(I+3)-5.0D0*X(I+4)*X(I+5)-Q
      D=X(I+1)**3+X(I+2)**3+1.0D0-R
      FA=A+1.0D1*(B**2+C**2+D**2)
      RETURN
  170 A=X(KA)-3.0D0
      B=X(KA)-X(KA+1)
      FA=A**2+B**2+EXP(2.0D1*B)
      RETURN
  180 A=X(KA+1)**2
      B=X(KA)**2
      C=A+1.0D0
      D=B+1.0D0
      FA=B**C+A**D
      RETURN
  190 P=1.0D0/DBLE(N+1)
      Q=0.5D0*P**2
      A=2.0D0*X(KA)+Q*(X(KA)+DBLE(KA)*P+1.0D0)**3
      IF (KA.GT.1) A=A-X(KA-1)
      IF (KA.LT.N) A=A-X(KA+1)
      FA=A**2
      RETURN
  200 P=1.0D0/DBLE(N+1)
      Q=2.0D0/P
      R=2.0D0*P
      A=X(KA)-X(KA+1)
      FA=Q*X(KA)*A
      IF (ABS(A).LE.1.0D-6) THEN
        FA=FA+R*EXP(X(KA+1))*(1.0D0+A/2.0D0*(1.0D0+A/3.0D0*(1.0D0+A/
     &   4.0D0)))
      ELSE
        B=EXP(X(KA))-EXP(X(KA+1))
        FA=FA+R*B/A
      END IF
      IF (KA.EQ.1) THEN
        FA=FA+R*(EXP(X(1))-1.0D0)/X(1)
      ELSE IF (KA.EQ.N-1) THEN
        FA=FA+Q*X(N)**2+R*(EXP(X(N))-1.0D0)/X(N)
      END IF
      RETURN
  210 A=DBLE(KA)*(1.0D0-COS(X(KA)))
      IF (KA.GT.1) A=A+DBLE(KA)*SIN(X(KA-1))
      IF (KA.LT.N) A=A-DBLE(KA)*SIN(X(KA+1))
      FA=A
      RETURN
  220 P=1.0D0/DBLE(N+1)
      IF (KA.EQ.1) THEN
        FA=0.25D0*X(KA)**2/P+1.25D-1*X(KA+1)**2/P+P*(EXP(X(KA))-1.0D0)
      ELSE IF (KA.EQ.N) THEN
        FA=0.25D0*X(KA)**2/P+1.25D-1*X(KA-1)**2/P+P*(EXP(X(KA))-1.0D0)
      ELSE
        FA=1.25D-1*(X(KA+1)-X(KA-1))**2/P+P*(EXP(X(KA))-1.0D0)
      END IF
      RETURN
  230 P=1.0D0/DBLE(N+1)
      Q=DBLE(KA)*P
      IF (KA.EQ.1) THEN
        FA=0.5D0*X(KA)**2/P+0.25D0*X(KA+1)**2/P-P*(X(KA)**2+2.0D0*X(KA)*
     &   Q)
      ELSE IF (KA.EQ.N) THEN
        FA=0.5D0*X(KA)**2/P+0.25D0*X(KA-1)**2/P-P*(X(KA)**2+2.0D0*X(KA)*
     &   Q)
      ELSE
        FA=2.5D-1*(X(KA+1)-X(KA-1))**2/P-P*(X(KA)**2+2.0D0*X(KA)*Q)
      END IF
      RETURN
  240 P=1.0D0/DBLE(N+1)
      Q=EXP(2.0D0*DBLE(KA)*P)
      IF (KA.EQ.1) THEN
        R=1.0D0/3.0D0
        FA=0.5D0*(X(KA)-R)**2/P+7.0D0*R**2+2.5D-1*(X(KA+1)-R)**2/P+P*
     &   (X(KA)**2+2.0D0*X(KA)*Q)
      ELSE IF (KA.EQ.N) THEN
        R=EXP(2.0D0)/3.0D0
        FA=0.5D0*(X(KA)-R)**2/P+7.0D0*R**2+2.5D-1*(X(KA-1)-R)**2/P+P*
     &   (X(KA)**2+2.0D0*X(KA)*Q)
      ELSE
        FA=2.5D-1*(X(KA+1)-X(KA-1))**2/P+P*(X(KA)**2+2.0D0*X(KA)*Q)
      END IF
      RETURN
  250 P=1.0D0/DBLE(N+1)
      IF (KA.EQ.1) THEN
        FA=(0.5D0*X(KA)**2/P-P)+(2.5D-1*X(KA+1)**2/P-P)*EXP(-2.0D0*X(KA)
     &   **2)
      ELSE IF (KA.EQ.N) THEN
        FA=(0.5D0*X(KA)**2/P-P)*EXP(-2.0D0)+(2.5D-1*X(KA-1)**2/P-P)*
     &   EXP(-2.0D0*X(KA)**2)
      ELSE
        FA=(2.5D-1*(X(KA+1)-X(KA-1))**2/P-P)*EXP(-2.0D0*X(KA)**2)
      END IF
      RETURN
  260 P=1.0D0/DBLE(N+1)
      IF (KA.EQ.1) THEN
        A=0.5D0*(X(KA+1)-1.0D0)/P
        B=(X(KA)-1.0D0)/P
        FA=P*(X(KA)**2+A*ATAN(A)-LOG(SQRT(1.0D0+A**2)))+0.5D0*P*(1.0D0+
     &   B*ATAN(B)-LOG(SQRT(1.0D0+B**2)))
      ELSE IF (KA.EQ.N) THEN
        A=0.5D0*(2.0D0-X(KA-1))/P
        B=(2.0D0-X(KA))/P
        FA=P*(X(KA)**2+A*ATAN(A)-LOG(SQRT(1.0D0+A**2)))+0.5D0*P*(4.0D0+
     &   B*ATAN(B)-LOG(SQRT(1.0D0+B**2)))
      ELSE
        A=0.5D0*(X(KA+1)-X(KA-1))/P
        FA=P*(X(KA)**2+A*ATAN(A)-LOG(SQRT(1.0D0+A**2)))
      END IF
      RETURN
  270 P=1.0D0/DBLE(N+1)
      IF (KA.EQ.1) THEN
        A=0.5D0*X(KA+1)/P
        B=X(KA)/P
        FA=P*(1.0D2*(X(KA)-A**2)**2+(1.0D0-A)**2)+0.5D0*P*(1.0D2*B**4+
     &   (1.0D0-B)**2)
      ELSE IF (KA.EQ.N) THEN
        A=-0.5D0*X(KA-1)/P
        B=-X(KA)/P
        FA=P*(1.0D2*(X(KA)-A**2)**2+(1.0D0-A)**2)+0.5D0*P*(1.0D2*B**4+
     &   (1.0D0-B)**2)
      ELSE
        A=0.5D0*(X(KA+1)-X(KA-1))/P
        FA=P*(1.0D2*(X(KA)-A**2)**2+(1.0D0-A)**2)
      END IF
      RETURN
      END
! SUBROUTINE TAGU14                ALL SYSTEMS                92/12/01
! PORTABILITY : ALL SYSTEMS
! 92/12/01 RA : ORIGINAL VERSION
!
! PURPOSE :
!  GRADIENTS OF MODEL FUNCTIONS FOR UNCONSTRAINED MINIMIZATION.
!  SPARSE VERSION - LU VERSION WITH MODIFIED TESTS NO 7-10,12.
!
! PARAMETERS :
!  II  N  NUMBER OF VARIABLES.
!  RI  X(N)  VECTOR OF VARIABLES.
!  RO  G(N)  GRADIENT OF THE MODEL FUNCTION.
!  II  NEXT  NUMBER OF THE TEST PROBLEM.
!
      SUBROUTINE TAGU14 (N, KA, X, GA, NEXT)
      INTEGER N,NEXT
      DOUBLE PRECISION X(*),GA(*)
      DOUBLE PRECISION A,B,C,D,P,Q,R,U,V
      INTEGER I,J,K,KA
      GO TO (10,20,30,40,50,60,90,100,130,150,170,190,200,210,220,230,
     &240,250,260,270,280,290),NEXT
   10 A=X(KA)**2-X(KA+1)
      B=X(KA)-1.0D0
      GA(KA)=4.0D2*X(KA)*A+2.0D0*B
      GA(KA+1)=-2.0D2*A
      RETURN
   20 I=2*KA-1
      A=X(I)**2-X(I+1)
      B=X(I)-1.0D0
      C=X(I+2)**2-X(I+3)
      D=X(I+2)-1.0D0
      U=X(I+1)+X(I+3)-2.0D0
      V=X(I+1)-X(I+3)
      GA(I)=4.0D2*X(I)*A+2.0D0*B
      GA(I+1)=-2.0D2*A+2.0D1*U+0.2D0*V
      GA(I+2)=3.6D2*X(I+2)*C+2.0D0*D
      GA(I+3)=-1.8D2*C+2.0D1*U-0.2D0*V
      RETURN
   30 I=2*KA-1
      A=X(I)+1.0D1*X(I+1)
      B=X(I+2)-X(I+3)
      C=X(I+1)-2.0D0*X(I+2)
      D=X(I)-X(I+3)
      GA(I)=2.0D0*A+4.0D1*D**3
      GA(I+1)=2.0D1*A+4.0D0*C**3
      GA(I+2)=-8.0D0*C**3+1.0D1*B
      GA(I+3)=-4.0D1*D**3-1.0D1*B
      RETURN
   40 I=2*KA-1
      A=EXP(X(I))
      B=A-X(I+1)
      B=4.0D0*B**3
      D=X(I+1)-X(I+2)
      D=6.0D2*D**5
      P=X(I+2)-X(I+3)
      C=COS(P)
      Q=SIN(P)/COS(P)
      Q=4.0D0*Q**3/C**2
      U=X(I)
      V=X(I+3)-1.0D0
      GA(I)=A*B+8.0D0*U**7
      GA(I+1)=D-B
      GA(I+2)=Q-D
      GA(I+3)=2.0D0*V-Q
      RETURN
   50 P=7.0D0/3.0D0
      A=(3.0D0-2.0D0*X(KA))*X(KA)+1.0D0
      IF (KA.GT.1) A=A-X(KA-1)
      IF (KA.LT.N) A=A-X(KA+1)
      B=P*ABS(A)**(P-1.0D0)*SIGN(1.0D0,A)
      GA(KA)=B*(3.0D0-4.0D0*X(KA))
      IF (KA.GT.1) GA(KA-1)=-B
      IF (KA.LT.N) GA(KA+1)=-B
      RETURN
   60 P=7.0D0/3.0D0
      A=(2.0D0+5.0D0*X(KA)**2)*X(KA)+1.0D0
      DO 70 I=MAX(1,KA-5),MIN(N,KA+1)
        A=A+X(I)*(1.0D0+X(I))
   70 CONTINUE
      B=P*ABS(A)**(P-1.0D0)*SIGN(1.0D0,A)
      DO 80 I=MAX(1,KA-5),MIN(N,KA+1)
        GA(I)=B*(1.0D0+2.0D0*X(I))
   80 CONTINUE
      GA(KA)=GA(KA)+B*(2.0D0+1.5D1*X(KA)**2)
      RETURN
   90 P=7.0D0/3.0D0
      IF (KA.LE.N) THEN
        A=(3.0D0-2.0D0*X(KA))*X(KA)+1.0D0
        IF (KA.GT.1) A=A-X(KA-1)
        IF (KA.LT.N) A=A-X(KA+1)
        B=P*ABS(A)**(P-1.0D0)*SIGN(1.0D0,A)
        GA(KA)=B*(3.0D0-4.0D0*X(KA))
        IF (KA.GT.1) GA(KA-1)=-B
        IF (KA.LT.N) GA(KA+1)=-B
      ELSE
        I=KA-N
        A=X(I)+X(I+N/2)
        B=P*ABS(A)**(P-1.0D0)*SIGN(1.0D0,A)
        GA(I)=B
        GA(I+N/2)=B
      END IF
      RETURN
  100 K=N/2
      P=0.0D0
      DO 110 I=KA-2,KA+2
        IF (I.LT.1.OR.I.GT.N) GO TO 110
        A=5.0D0*(1.0D0+MOD(I,5)+MOD(KA,5))
        B=DBLE(I+KA)/1.0D1
        P=P+A*SIN(X(I))+B*COS(X(I))
  110 CONTINUE
      IF (KA.GT.K) THEN
        I=KA-K
        A=5.0D0*(1.0D0+MOD(I,5)+MOD(KA,5))
        B=DBLE(I+KA)/1.0D1
        P=P+A*SIN(X(I))+B*COS(X(I))
      ELSE
        I=KA+K
        A=5.0D0*(1.0D0+MOD(I,5)+MOD(KA,5))
        B=DBLE(I+KA)/1.0D1
        P=P+A*SIN(X(I))+B*COS(X(I))
      END IF
      P=2.0D0*(DBLE(N+KA)-P)/DBLE(N)
      DO 120 I=KA-2,KA+2
        IF (I.LT.1.OR.I.GT.N) GO TO 120
        A=5.0D0*(1.0D0+MOD(I,5)+MOD(KA,5))
        B=DBLE(I+KA)/1.0D1
        GA(I)=-P*(A*COS(X(I))-B*SIN(X(I)))
  120 CONTINUE
      IF (KA.GT.K) THEN
        I=KA-K
        A=5.0D0*(1.0D0+MOD(I,5)+MOD(KA,5))
        B=DBLE(I+KA)/1.0D1
        GA(I)=-P*(A*COS(X(I))-B*SIN(X(I)))
      ELSE
        I=KA+K
        A=5.0D0*(1.0D0+MOD(I,5)+MOD(KA,5))
        B=DBLE(I+KA)/1.0D1
        GA(I)=-P*(A*COS(X(I))-B*SIN(X(I)))
      END IF
      RETURN
  130 K=N/2
      P=1.0D0/DBLE(N)
      DO 140 I=KA-2,KA+2
        IF (I.LT.1.OR.I.GT.N) GO TO 140
        A=5.0D0*(1.0D0+MOD(I,5)+MOD(KA,5))
        B=DBLE(I+KA)/1.0D1
        GA(I)=P*(A*COS(X(I))-B*SIN(X(I)))
  140 CONTINUE
      IF (KA.GT.K) THEN
        I=KA-K
        A=5.0D0*(1.0D0+MOD(I,5)+MOD(KA,5))
        B=DBLE(I+KA)/1.0D1
        GA(I)=P*(A*COS(X(I))-B*SIN(X(I)))
      ELSE
        I=KA+K
        A=5.0D0*(1.0D0+MOD(I,5)+MOD(KA,5))
        B=DBLE(I+KA)/1.0D1
        GA(I)=P*(A*COS(X(I))-B*SIN(X(I)))
      END IF
      GA(KA)=GA(KA)+P*DBLE(KA)*SIN(X(KA))
      RETURN
  150 K=N/2
      GA(KA)=0.0D0
      Q=1.0D0+DBLE(KA)/1.0D1
      DO 160 I=KA-2,KA+2
        IF (I.LT.1.OR.I.GT.N) GO TO 160
        A=5.0D0*(1.0D0+MOD(I,5)+MOD(KA,5))
        B=1.0D0+DBLE(I)/1.0D1
        C=DBLE(I+KA)/1.0D1
        P=A*COS(Q*X(KA)+B*X(I)+C)/DBLE(N)
        GA(KA)=GA(KA)+P*Q
        IF (I.EQ.KA) THEN
          GA(I)=GA(I)+P*B
        ELSE
          GA(I)=P*B
        END IF
  160 CONTINUE
      IF (KA.GT.K) THEN
        I=KA-K
        A=5.0D0*(1.0D0+MOD(I,5)+MOD(KA,5))
        B=1.0D0+DBLE(I)/1.0D1
        C=DBLE(I+KA)/1.0D1
        P=A*COS(Q*X(KA)+B*X(I)+C)/DBLE(N)
        GA(KA)=GA(KA)+P*Q
        GA(I)=P*B
      ELSE
        I=KA+K
        A=5.0D0*(1.0D0+MOD(I,5)+MOD(KA,5))
        B=1.0D0+DBLE(I)/1.0D1
        C=DBLE(I+KA)/1.0D1
        P=A*COS(Q*X(KA)+B*X(I)+C)/DBLE(N)
        GA(KA)=GA(KA)+P*Q
        GA(I)=P*B
      END IF
      RETURN
  170 P=-0.2008D-2
      Q=-0.1900D-2
      R=-0.0261D-2
      I=5*(KA-1)
      A=1.0D0
      B=0.0D0
      DO 180 J=1,5
        A=A*X(I+J)
        B=B+X(I+J)**2
  180 CONTINUE
      A=A*EXP(A)
      B=B-1.0D1-P
      C=X(I+2)*X(I+3)-5.0D0*X(I+4)*X(I+5)-Q
      D=X(I+1)**3+X(I+2)**3+1.0D0-R
      GA(I+1)=A/X(I+1)+2.0D1*(2.0D0*B*X(I+1)+3.0D0*D*X(I+1)**2)
      GA(I+2)=A/X(I+2)+2.0D1*(2.0D0*B*X(I+2)+C*X(I+3)+3.0D0*D*X(I+2)**2)
      GA(I+3)=A/X(I+3)+2.0D1*(2.0D0*B*X(I+3)+C*X(I+2))
      GA(I+4)=A/X(I+4)+2.0D1*(2.0D0*B*X(I+4)-5.0D0*C*X(I+5))
      GA(I+5)=A/X(I+5)+2.0D1*(2.0D0*B*X(I+5)-5.0D0*C*X(I+4))
      RETURN
  190 A=X(KA)-3.0D0
      B=X(KA)-X(KA+1)
      GA(KA)=2.0D0*A+2.0D0*B+2.0D1*EXP(2.0D1*B)
      GA(KA+1)=-2.0D0*B-2.0D1*EXP(2.0D1*B)
      RETURN
  200 A=X(KA+1)**2
      B=X(KA)**2
      C=A+1.0D0
      D=B+1.0D0
      P=0.0D0
      IF (A.GT.P) P=LOG(A)
      Q=0.0D0
      IF (B.GT.Q) Q=LOG(B)
      IF (X(KA).EQ.0.0D0) THEN
        GA(KA)=0.0D0
      ELSE
        GA(KA)=2.0D0*X(KA)*(C*B**A+P*A**D)
      ENDIF
      IF (X(KA+1).EQ.0.0D0) THEN
        GA(KA+1)=0.0D0
      ELSE
        GA(KA+1)=2.0D0*X(KA+1)*(D*A**B+Q*B**C)
      ENDIF
      RETURN
  210 P=1.0D0/DBLE(N+1)
      Q=0.5D0*P**2
      A=2.0D0*X(KA)+Q*(X(KA)+DBLE(KA)*P+1.0D0)**3
      IF (KA.GT.1) A=A-X(KA-1)
      IF (KA.LT.N) A=A-X(KA+1)
      GA(KA)=A*(4.0D0+6.0D0*Q*(X(KA)+DBLE(KA)*P+1.0D0)**2.0D0)
      IF (KA.GT.1) GA(KA-1)=-2.0D0*A
      IF (KA.LT.N) GA(KA+1)=-2.0D0*A
      RETURN
  220 P=1.0D0/DBLE(N+1)
      Q=2.0D0/P
      R=2.0D0*P
      A=X(KA)-X(KA+1)
      GA(KA)=Q*(2.0D0*X(KA)-X(KA+1))
      GA(KA+1)=-Q*X(KA)
      IF (ABS(A).LE.1.0D-6) THEN
        GA(KA)=GA(KA)+R*EXP(X(KA+1))*(1.0D0/2.0D0+A*(1.0D0/3.0D0+A/
     &   8.0D0))
        GA(KA+1)=GA(KA+1)+R*EXP(X(KA+1))*(1.0D0/2.0D0+A*(1.0D0/6.0D0+A/
     &   24.0D0))
      ELSE
        B=EXP(X(KA))-EXP(X(KA+1))
        GA(KA)=GA(KA)+R*(EXP(X(KA))*A-B)/A**2
        GA(KA+1)=GA(KA+1)-R*(EXP(X(KA+1))*A-B)/A**2
      END IF
      IF (KA.EQ.1) THEN
        GA(1)=GA(1)+R*(EXP(X(1))*(X(1)-1.0D0)+1.0D0)/X(1)**2
      ELSE IF (KA.EQ.N-1) THEN
        GA(N)=GA(N)+2.0D0*Q*X(N)+R*(EXP(X(N))*(X(N)-1.0D0)+1.0D0)/X(N)**
     &   2
      END IF
      RETURN
  230 A=DBLE(KA)*SIN(X(KA))
      GA(KA)=A
      IF (KA.GT.1) GA(KA-1)=+DBLE(KA)*COS(X(KA-1))
      IF (KA.LT.N) GA(KA+1)=-DBLE(KA)*COS(X(KA+1))
      RETURN
  240 P=1.0D0/DBLE(N+1)
      IF (KA.EQ.1) THEN
        GA(KA)=0.5D0*X(KA)/P+P*EXP(X(KA))
        GA(KA+1)=0.25D0*X(KA+1)/P
      ELSE IF (KA.EQ.N) THEN
        GA(KA)=0.5D0*X(KA)/P+P*EXP(X(KA))
        GA(KA-1)=0.25D0*X(KA-1)/P
      ELSE
        A=0.25D0*(X(KA+1)-X(KA-1))/P
        GA(KA)=P*EXP(X(KA))
        GA(KA-1)=-A
        GA(KA+1)=A
      END IF
      RETURN
  250 P=1.0D0/DBLE(N+1)
      Q=DBLE(KA)*P
      IF (KA.EQ.1) THEN
        GA(KA)=X(KA)/P-2.0D0*P*(X(KA)+Q)
        GA(KA+1)=0.5D0*X(KA+1)/P
      ELSE IF (KA.EQ.N) THEN
        GA(KA)=X(KA)/P-2.0D0*P*(X(KA)+Q)
        GA(KA-1)=0.5D0*X(KA-1)/P
      ELSE
        A=0.5D0*(X(KA+1)-X(KA-1))/P
        GA(KA)=-2.0D0*P*(X(KA)+Q)
        GA(KA-1)=-A
        GA(KA+1)=A
      END IF
      RETURN
  260 P=1.0D0/DBLE(N+1)
      Q=EXP(2.0D0*DBLE(KA)*P)
      IF (KA.EQ.1) THEN
        R=1.0D0/3.0D0
        A=0.5D0*(X(KA+1)-R)/P
        GA(KA)=2.0D0*P*(X(KA)+Q)+(X(KA)-R)/P
        GA(KA+1)=A
      ELSE IF (KA.EQ.N) THEN
        R=EXP(2.0D0)/3.0D0
        A=0.5D0*(X(KA-1)-R)/P
        GA(KA)=2.0D0*P*(X(KA)+Q)+(X(KA)-R)/P
        GA(KA-1)=A
      ELSE
        A=0.5D0*(X(KA+1)-X(KA-1))/P
        GA(KA)=2.0D0*P*(X(KA)+Q)
        GA(KA-1)=-A
        GA(KA+1)=A
      END IF
      RETURN
  270 P=1.0D0/DBLE(N+1)
      A=EXP(-2.0D0*X(KA)**2)
      IF (KA.EQ.1) THEN
        B=0.5D0*X(KA+1)/P
        GA(KA)=X(KA)/P-4.0D0*X(KA)*A*P*(B**2-1.0D0)
        GA(KA+1)=A*B
      ELSE IF (KA.EQ.N) THEN
        B=0.5D0*X(KA-1)/P
        GA(KA)=X(KA)/P*EXP(-2.0D0)-4.0D0*X(KA)*A*P*(B**2-1.0D0)
        GA(KA-1)=A*B
      ELSE
        B=0.5D0*(X(KA+1)-X(KA-1))/P
        GA(KA)=-4.0D0*X(KA)*A*P*(B**2-1.0D0)
        GA(KA-1)=-A*B
        GA(KA+1)=A*B
      END IF
      RETURN
  280 P=1.0D0/DBLE(N+1)
      IF (KA.EQ.1) THEN
        A=0.5D0*(X(KA+1)-1.0D0)/P
        B=(X(KA)-1.0D0)/P
        U=0.5D0*ATAN(A)
        V=0.5D0*ATAN(B)
        GA(KA)=2.0D0*P*X(KA)+V
        GA(KA+1)=U
      ELSE IF (KA.EQ.N) THEN
        A=0.5D0*(2.0D0-X(KA-1))/P
        B=(2.0D0-X(KA))/P
        U=0.5D0*ATAN(A)
        V=0.5D0*ATAN(B)
        GA(KA)=2.0D0*P*X(KA)-V
        GA(KA-1)=-U
      ELSE
        A=0.5D0*(X(KA+1)-X(KA-1))/P
        U=0.5D0*ATAN(A)
        GA(KA)=2.0D0*P*X(KA)
        GA(KA-1)=-U
        GA(KA+1)=U
      END IF
      RETURN
  290 P=1.0D0/DBLE(N+1)
      IF (KA.EQ.1) THEN
        A=0.5D0*X(KA+1)/P
        B=X(KA)/P
        GA(KA)=2.0D2*P*(X(KA)-A**2)+2.0D2*B**3-(1.0D0-B)
        GA(KA+1)=-2.0D2*(X(KA)-A**2)*A-(1.0D0-A)
      ELSE IF (KA.EQ.N) THEN
        A=-0.5D0*X(KA-1)/P
        B=-X(KA)/P
        GA(KA)=2.0D2*P*(X(KA)-A**2)-2.0D2*B**3+(1.0D0-B)
        GA(KA-1)=2.0D2*(X(KA)-A**2)*A+(1.0D0-A)
      ELSE
        A=0.5D0*(X(KA+1)-X(KA-1))/P
        GA(KA)=2.0D2*P*(X(KA)-A**2)
        GA(KA-1)=2.0D2*(X(KA)-A**2)*A+(1.0D0-A)
        GA(KA+1)=-2.0D2*(X(KA)-A**2)*A-(1.0D0-A)
      END IF
      RETURN
      END
! SUBROUTINE TFFU14                ALL SYSTEMS                98/12/01
! PORTABILITY : ALL SYSTEMS
! 98/12/01 TU : ORIGINAL VERSION
!
! PURPOSE :
!  VALUES OF MODEL FUNCTIONS FOR UNCONSTRAINED MINIMIZATION.
!  SPARSE VERSION.
!
! PARAMETERS :
!  II  N  NUMBER OF VARIABLES.
!  RI  X(N)  VECTOR OF VARIABLES.
!  RO  F  VALUE OF THE MODEL FUNCTION.
!  II  NEXT  NUMBER OF THE TEST PROBLEM.
!
      SUBROUTINE TFFU14 (N, X, F, NEXT)
      INTEGER N,NEXT
      DOUBLE PRECISION X(*),F
      DOUBLE PRECISION A,B,C,D,P,Q,R,U,V
      INTEGER I,J,K
      F=0.0D0
      GO TO (10,30,50,70,90,110,140,160,190,220,250,280,300,320,340,360,
     &380,400,420,440,460,480),NEXT
   10 DO 20 J=2,N
        A=X(J-1)**2-X(J)
        B=X(J-1)-1.0D0
        F=F+1.0D2*A**2+B**2
   20 CONTINUE
      RETURN
   30 DO 40 J=2,N-2,2
        A=X(J-1)**2-X(J)
        B=X(J-1)-1.0D0
        C=X(J+1)**2-X(J+2)
        D=X(J+1)-1.0D0
        U=X(J)+X(J+2)-2.0D0
        V=X(J)-X(J+2)
        F=F+1.0D2*A**2+B**2+9.0D1*C**2+D**2+1.0D1*U**2+0.1D0*V**2
   40 CONTINUE
      RETURN
   50 DO 60 J=2,N-2,2
        A=X(J-1)+1.0D1*X(J)
        B=X(J+1)-X(J+2)
        C=X(J)-2.0D0*X(J+1)
        D=X(J-1)-X(J+2)
        F=F+A**2+5.0D0*B**2+C**4+1.0D1*D**4
   60 CONTINUE
      RETURN
   70 DO 80 J=2,N-2,2
        A=EXP(X(J-1))
        B=A-X(J)
        D=X(J)-X(J+1)
        P=X(J+1)-X(J+2)
        Q=SIN(P)/COS(P)
        U=X(J-1)
        V=X(J+2)-1.0D0
        F=F+B**4+1.0D2*D**6+Q**4+U**8+V**2
   80 CONTINUE
      RETURN
   90 P=7.0D0/3.0D0
      DO 100 J=1,N
        A=(3.0D0-2.0D0*X(J))*X(J)+1.0D0
        IF (J.GT.1) A=A-X(J-1)
        IF (J.LT.N) A=A-X(J+1)
        F=F+ABS(A)**P
  100 CONTINUE
      RETURN
  110 P=7.0D0/3.0D0
      DO 130 J=1,N
        A=(2.0D0+5.0D0*X(J)**2)*X(J)+1.0D0
        DO 120 I=MAX(1,J-5),MIN(N,J+1)
          A=A+X(I)*(1.0D0+X(I))
  120   CONTINUE
        F=F+ABS(A)**P
  130 CONTINUE
      RETURN
  140 P=7.0D0/3.0D0
      K=N/2
      DO 150 J=1,N
        A=(3.0D0-2.0D0*X(J))*X(J)+1.0D0
        IF (J.GT.1) A=A-X(J-1)
        IF (J.LT.N) A=A-X(J+1)
        F=F+ABS(A)**P
        IF (J.LE.K) THEN
          F=F+ABS(X(J)+X(J+K))**P
        END IF
  150 CONTINUE
      RETURN
  160 K=N/2
      DO 180 J=1,N
        P=0.0D0
        DO 170 I=J-2,J+2
          IF (I.LT.1.OR.I.GT.N) GO TO 170
          A=5.0D0*(1.0D0+MOD(I,5)+MOD(J,5))
          B=DBLE(I+J)/1.0D1
          P=P+A*SIN(X(I))+B*COS(X(I))
  170   CONTINUE
        IF (J.GT.K) THEN
          I=J-K
          A=5.0D0*(1.0D0+MOD(I,5)+MOD(J,5))
          B=DBLE(I+J)/1.0D1
          P=P+A*SIN(X(I))+B*COS(X(I))
        ELSE
          I=J+K
          A=5.0D0*(1.0D0+MOD(I,5)+MOD(J,5))
          B=DBLE(I+J)/1.0D1
          P=P+A*SIN(X(I))+B*COS(X(I))
        END IF
        F=F+(DBLE(N+J)-P)**2/DBLE(N)
  180 CONTINUE
      RETURN
  190 K=N/2
      DO 210 J=1,N
        P=0.0D0
        DO 200 I=J-2,J+2
          IF (I.LT.1.OR.I.GT.N) GO TO 200
          A=5.0D0*(1.0D0+MOD(I,5)+MOD(J,5))
          B=DBLE(I+J)/1.0D1
          P=P+A*SIN(X(I))+B*COS(X(I))
  200   CONTINUE
        IF (J.GT.K) THEN
          I=J-K
          A=5.0D0*(1.0D0+MOD(I,5)+MOD(J,5))
          B=DBLE(I+J)/1.0D1
          P=P+A*SIN(X(I))+B*COS(X(I))
        ELSE
          I=J+K
          A=5.0D0*(1.0D0+MOD(I,5)+MOD(J,5))
          B=DBLE(I+J)/1.0D1
          P=P+A*SIN(X(I))+B*COS(X(I))
        END IF
        F=F+(P+DBLE(J)*(1.0D0-COS(X(J))))/DBLE(N)
  210 CONTINUE
      RETURN
  220 K=N/2
      DO 240 J=1,N
        P=0.0D0
        Q=1.0D0+DBLE(J)/1.0D1
        DO 230 I=J-2,J+2
          IF (I.LT.1.OR.I.GT.N) GO TO 230
          A=5.0D0*(1.0D0+MOD(I,5)+MOD(J,5))
          B=1.0D0+DBLE(I)/1.0D1
          C=DBLE(I+J)/1.0D1
          P=P+A*SIN(Q*X(J)+B*X(I)+C)
  230   CONTINUE
        IF (J.GT.K) THEN
          I=J-K
          A=5.0D0*(1.0D0+MOD(I,5)+MOD(J,5))
          B=1.0D0+DBLE(I)/1.0D1
          C=DBLE(I+J)/1.0D1
          P=P+A*SIN(Q*X(J)+B*X(I)+C)
        ELSE
          I=J+K
          A=5.0D0*(1.0D0+MOD(I,5)+MOD(J,5))
          B=1.0D0+DBLE(I)/1.0D1
          C=DBLE(I+J)/1.0D1
          P=P+A*SIN(Q*X(J)+B*X(I)+C)
        END IF
        F=F+P
  240 CONTINUE
      F=F/DBLE(N)
      RETURN
  250 P=-0.2008D-2
      Q=-0.1900D-2
      R=-0.0261D-2
      DO 270 I=0,N-5,5
        A=1.0D0
        B=0.0D0
        DO 260 J=1,5
          A=A*X(I+J)
          B=B+X(I+J)**2
  260   CONTINUE
        A=EXP(A)
        B=B-1.0D1-P
        C=X(I+2)*X(I+3)-5.0D0*X(I+4)*X(I+5)-Q
        D=X(I+1)**3+X(I+2)**3+1.0D0-R
        F=F+A+1.0D1*(B**2+C**2+D**2)
  270 CONTINUE
      RETURN
  280 DO 290 J=2,N
        A=X(J-1)-3.0D0
        B=X(J-1)-X(J)
        F=F+A**2+B**2+EXP(2.0D1*B)
  290 CONTINUE
      RETURN
  300 DO 310 J=2,N
        A=X(J)**2
        B=X(J-1)**2
        C=A+1.0D0
        D=B+1.0D0
        F=F+B**C+A**D
  310 CONTINUE
      RETURN
  320 P=1.0D0/DBLE(N+1)
      Q=0.5D0*P**2
      DO 330 J=1,N
        A=2.0D0*X(J)+Q*(X(J)+DBLE(J)*P+1.0D0)**3
        IF (J.GT.1) A=A-X(J-1)
        IF (J.LT.N) A=A-X(J+1)
        F=F+A**2
  330 CONTINUE
      RETURN
  340 P=1.0D0/DBLE(N+1)
      Q=2.0D0/P
      R=2.0D0*P
      DO 350 J=2,N
        A=X(J-1)-X(J)
        F=F+Q*X(J-1)*A
        IF (ABS(A).LE.1.0D-6) THEN
          F=F+R*EXP(X(J))*(1.0D0+A/2.0D0*(1.0D0+A/3.0D0*(1.0D0+A/4.0D0))
     &     )
        ELSE
          B=EXP(X(J-1))-EXP(X(J))
          F=F+R*B/A
        END IF
  350 CONTINUE
      F=F+Q*X(N)**2+R*(EXP(X(1))-1.0D0)/X(1)+R*(EXP(X(N))-1.0D0)/X(N)
      RETURN
  360 DO 370 J=1,N
        A=DBLE(J)*(1.0D0-COS(X(J)))
        IF (J.GT.1) A=A+DBLE(J)*SIN(X(J-1))
        IF (J.LT.N) A=A-DBLE(J)*SIN(X(J+1))
        F=F+A
  370 CONTINUE
      RETURN
  380 P=1.0D0/DBLE(N+1)
      DO 390 J=1,N
        IF (J.EQ.1) THEN
          F=F+0.25D0*X(J)**2/P+1.25D-1*X(J+1)**2/P+P*(EXP(X(J))-1.0D0)
        ELSE IF (J.EQ.N) THEN
          F=F+0.25D0*X(J)**2/P+1.25D-1*X(J-1)**2/P+P*(EXP(X(J))-1.0D0)
        ELSE
          F=F+1.25D-1*(X(J+1)-X(J-1))**2/P+P*(EXP(X(J))-1.0D0)
        END IF
  390 CONTINUE
      RETURN
  400 P=1.0D0/DBLE(N+1)
      DO 410 J=1,N
        Q=DBLE(J)*P
        IF (J.EQ.1) THEN
          F=F+0.5D0*X(J)**2/P+0.25D0*X(J+1)**2/P-P*(X(J)**2+2.0D0*X(J)*
     &     Q)
        ELSE IF (J.EQ.N) THEN
          F=F+0.5D0*X(J)**2/P+0.25D0*X(J-1)**2/P-P*(X(J)**2+2.0D0*X(J)*
     &     Q)
        ELSE
          F=F+2.5D-1*(X(J+1)-X(J-1))**2/P-P*(X(J)**2+2.0D0*X(J)*Q)
        END IF
  410 CONTINUE
      RETURN
  420 P=1.0D0/DBLE(N+1)
      DO 430 J=1,N
        Q=EXP(2.0D0*DBLE(J)*P)
        IF (J.EQ.1) THEN
          R=1.0D0/3.0D0
          F=F+0.5D0*(X(J)-R)**2/P+7.0D0*R**2+2.5D-1*(X(J+1)-R)**2/P+P*
     &     (X(J)**2+2.0D0*X(J)*Q)
        ELSE IF (J.EQ.N) THEN
          R=EXP(2.0D0)/3.0D0
          F=F+0.5D0*(X(J)-R)**2/P+7.0D0*R**2+2.5D-1*(X(J-1)-R)**2/P+P*
     &     (X(J)**2+2.0D0*X(J)*Q)
        ELSE
          F=F+2.5D-1*(X(J+1)-X(J-1))**2/P+P*(X(J)**2+2.0D0*X(J)*Q)
        END IF
  430 CONTINUE
      RETURN
  440 P=1.0D0/DBLE(N+1)
      DO 450 J=1,N
        IF (J.EQ.1) THEN
          F=F+(0.5D0*X(J)**2/P-P)+(2.5D-1*X(J+1)**2/P-P)*EXP(-2.0D0*X(J)
     &     **2)
        ELSE IF (J.EQ.N) THEN
          F=F+(0.5D0*X(J)**2/P-P)*EXP(-2.0D0)+(2.5D-1*X(J-1)**2/P-P)*
     &     EXP(-2.0D0*X(J)**2)
        ELSE
          F=F+(2.5D-1*(X(J+1)-X(J-1))**2/P-P)*EXP(-2.0D0*X(J)**2)
        END IF
  450 CONTINUE
      RETURN
  460 P=1.0D0/DBLE(N+1)
      DO 470 J=1,N
        IF (J.EQ.1) THEN
          A=0.5D0*(X(J+1)-1.0D0)/P
          B=(X(J)-1.0D0)/P
          F=F+P*(X(J)**2+A*ATAN(A)-LOG(SQRT(1.0D0+A**2)))+0.5D0*P*
     &     (1.0D0+B*ATAN(B)-LOG(SQRT(1.0D0+B**2)))
        ELSE IF (J.EQ.N) THEN
          A=0.5D0*(2.0D0-X(J-1))/P
          B=(2.0D0-X(J))/P
          F=F+P*(X(J)**2+A*ATAN(A)-LOG(SQRT(1.0D0+A**2)))+0.5D0*P*
     &     (4.0D0+B*ATAN(B)-LOG(SQRT(1.0D0+B**2)))
        ELSE
          A=0.5D0*(X(J+1)-X(J-1))/P
          F=F+P*(X(J)**2+A*ATAN(A)-LOG(SQRT(1.0D0+A**2)))
        END IF
  470 CONTINUE
      RETURN
  480 P=1.0D0/DBLE(N+1)
      DO 490 J=1,N
        IF (J.EQ.1) THEN
          A=0.5D0*X(J+1)/P
          B=X(J)/P
          F=F+P*(1.0D2*(X(J)-A**2)**2+(1.0D0-A)**2)+0.5D0*P*(1.0D2*B**4+
     &     (1.0D0-B)**2)
        ELSE IF (J.EQ.N) THEN
          A=-0.5D0*X(J-1)/P
          B=-X(J)/P
          F=F+P*(1.0D2*(X(J)-A**2)**2+(1.0D0-A)**2)+0.5D0*P*(1.0D2*B**4+
     &     (1.0D0-B)**2)
        ELSE
          A=0.5D0*(X(J+1)-X(J-1))/P
          F=F+P*(1.0D2*(X(J)-A**2)**2+(1.0D0-A)**2)
        END IF
  490 CONTINUE
      RETURN
      END
! SUBROUTINE TFGU14                ALL SYSTEMS                98/12/01
! PORTABILITY : ALL SYSTEMS
! 98/12/01 TU : ORIGINAL VERSION
!
! PURPOSE :
!  GRADIENTS OF MODEL FUNCTIONS FOR UNCONSTRAINED MINIMIZATION.
!  SPARSE VERSION - LU VERSION WITH MODIFIED TESTS NO 7-10,12.
!
! PARAMETERS :
!  II  N  NUMBER OF VARIABLES.
!  RI  X(N)  VECTOR OF VARIABLES.
!  RO  G(N)  GRADIENT OF THE MODEL FUNCTION.
!  II  NEXT  NUMBER OF THE TEST PROBLEM.
!
      SUBROUTINE TFGU14 (N, X, G, NEXT)
      INTEGER N,NEXT
      DOUBLE PRECISION X(*),G(*)
      DOUBLE PRECISION A,B,C,D,P,Q,R,U,V
      INTEGER I,J,K
      DO 10 I=1,N
        G(I)=0.0D0
   10 CONTINUE
      GO TO (20,40,60,80,100,120,160,180,220,250,280,310,330,350,370,
     &390,410,430,450,470,490,510),NEXT
   20 DO 30 J=2,N
        A=X(J-1)**2-X(J)
        B=X(J-1)-1.0D0
        G(J-1)=G(J-1)+4.0D2*X(J-1)*A+2.0D0*B
        G(J)=G(J)-2.0D2*A
   30 CONTINUE
      RETURN
   40 DO 50 J=2,N-2,2
        A=X(J-1)**2-X(J)
        B=X(J-1)-1.0D0
        C=X(J+1)**2-X(J+2)
        D=X(J+1)-1.0D0
        U=X(J)+X(J+2)-2.0D0
        V=X(J)-X(J+2)
        G(J-1)=G(J-1)+4.0D2*X(J-1)*A+2.0D0*B
        G(J)=G(J)-2.0D2*A+2.0D1*U+0.2D0*V
        G(J+1)=G(J+1)+3.6D2*X(J+1)*C+2.0D0*D
        G(J+2)=G(J+2)-1.8D2*C+2.0D1*U-0.2D0*V
   50 CONTINUE
      RETURN
   60 DO 70 J=2,N-2,2
        A=X(J-1)+1.0D1*X(J)
        B=X(J+1)-X(J+2)
        C=X(J)-2.0D0*X(J+1)
        D=X(J-1)-X(J+2)
        G(J-1)=G(J-1)+2.0D0*A+4.0D1*D**3
        G(J)=G(J)+2.0D1*A+4.0D0*C**3
        G(J+1)=G(J+1)-8.0D0*C**3+1.0D1*B
        G(J+2)=G(J+2)-4.0D1*D**3-1.0D1*B
   70 CONTINUE
      RETURN
   80 DO 90 J=2,N-2,2
        A=EXP(X(J-1))
        B=A-X(J)
        B=4.0D0*B**3
        D=X(J)-X(J+1)
        D=6.0D2*D**5
        P=X(J+1)-X(J+2)
        C=COS(P)
        Q=SIN(P)/COS(P)
        Q=4.0D0*Q**3/C**2
        U=X(J-1)
        V=X(J+2)-1.0D0
        G(J-1)=G(J-1)+A*B+8.0D0*U**7
        G(J)=G(J)+D-B
        G(J+1)=G(J+1)+Q-D
        G(J+2)=G(J+2)+2.0D0*V-Q
   90 CONTINUE
      RETURN
  100 P=7.0D0/3.0D0
      DO 110 J=1,N
        A=(3.0D0-2.0D0*X(J))*X(J)+1.0D0
        IF (J.GT.1) A=A-X(J-1)
        IF (J.LT.N) A=A-X(J+1)
        B=P*ABS(A)**(P-1.0D0)*SIGN(1.0D0,A)
        G(J)=G(J)+B*(3.0D0-4.0D0*X(J))
        IF (J.GT.1) G(J-1)=G(J-1)-B
        IF (J.LT.N) G(J+1)=G(J+1)-B
  110 CONTINUE
      RETURN
  120 P=7.0D0/3.0D0
      DO 150 J=1,N
        A=(2.0D0+5.0D0*X(J)**2)*X(J)+1.0D0
        DO 130 I=MAX(1,J-5),MIN(N,J+1)
          A=A+X(I)*(1.0D0+X(I))
  130   CONTINUE
        B=P*ABS(A)**(P-1.0D0)*SIGN(1.0D0,A)
        G(J)=G(J)+B*(2.0D0+1.5D1*X(J)**2)
        DO 140 I=MAX(1,J-5),MIN(N,J+1)
          G(I)=G(I)+B*(1.0D0+2.0D0*X(I))
  140   CONTINUE
  150 CONTINUE
      RETURN
  160 P=7.0D0/3.0D0
      K=N/2
      DO 170 J=1,N
        A=(3.0D0-2.0D0*X(J))*X(J)+1.0D0
        IF (J.GT.1) A=A-X(J-1)
        IF (J.LT.N) A=A-X(J+1)
        B=P*ABS(A)**(P-1.0D0)*SIGN(1.0D0,A)
        G(J)=G(J)+B*(3.0D0-4.0D0*X(J))
        IF (J.GT.1) G(J-1)=G(J-1)-B
        IF (J.LT.N) G(J+1)=G(J+1)-B
        IF (J.LE.K) THEN
          A=X(J)+X(J+K)
          B=P*ABS(A)**(P-1.0D0)*SIGN(1.0D0,A)
          G(J)=G(J)+B
          G(J+K)=G(J+K)+B
        END IF
  170 CONTINUE
      RETURN
  180 K=N/2
      DO 210 J=1,N
        P=0.0D0
        DO 190 I=J-2,J+2
          IF (I.LT.1.OR.I.GT.N) GO TO 190
          A=5.0D0*(1.0D0+MOD(I,5)+MOD(J,5))
          B=DBLE(I+J)/1.0D1
          P=P+A*SIN(X(I))+B*COS(X(I))
  190   CONTINUE
        IF (J.GT.K) THEN
          I=J-K
          A=5.0D0*(1.0D0+MOD(I,5)+MOD(J,5))
          B=DBLE(I+J)/1.0D1
          P=P+A*SIN(X(I))+B*COS(X(I))
        ELSE
          I=J+K
          A=5.0D0*(1.0D0+MOD(I,5)+MOD(J,5))
          B=DBLE(I+J)/1.0D1
          P=P+A*SIN(X(I))+B*COS(X(I))
        END IF
        P=2.0D0*(DBLE(N+J)-P)/DBLE(N)
        DO 200 I=J-2,J+2
          IF (I.LT.1.OR.I.GT.N) GO TO 200
          A=5.0D0*(1.0D0+MOD(I,5)+MOD(J,5))
          B=DBLE(I+J)/1.0D1
          G(I)=G(I)-P*(A*COS(X(I))-B*SIN(X(I)))
  200   CONTINUE
        IF (J.GT.K) THEN
          I=J-K
          A=5.0D0*(1.0D0+MOD(I,5)+MOD(J,5))
          B=DBLE(I+J)/1.0D1
          G(I)=G(I)-P*(A*COS(X(I))-B*SIN(X(I)))
        ELSE
          I=J+K
          A=5.0D0*(1.0D0+MOD(I,5)+MOD(J,5))
          B=DBLE(I+J)/1.0D1
          G(I)=G(I)-P*(A*COS(X(I))-B*SIN(X(I)))
        END IF
  210 CONTINUE
      RETURN
  220 K=N/2
      P=1.0D0/DBLE(N)
      DO 240 J=1,N
        DO 230 I=J-2,J+2
          IF (I.LT.1.OR.I.GT.N) GO TO 230
          A=5.0D0*(1.0D0+MOD(I,5)+MOD(J,5))
          B=DBLE(I+J)/1.0D1
          G(I)=G(I)+P*(A*COS(X(I))-B*SIN(X(I)))
  230   CONTINUE
        IF (J.GT.K) THEN
          I=J-K
          A=5.0D0*(1.0D0+MOD(I,5)+MOD(J,5))
          B=DBLE(I+J)/1.0D1
          G(I)=G(I)+P*(A*COS(X(I))-B*SIN(X(I)))
        ELSE
          I=J+K
          A=5.0D0*(1.0D0+MOD(I,5)+MOD(J,5))
          B=DBLE(I+J)/1.0D1
          G(I)=G(I)+P*(A*COS(X(I))-B*SIN(X(I)))
        END IF
        G(J)=G(J)+P*DBLE(J)*SIN(X(J))
  240 CONTINUE
      RETURN
  250 K=N/2
      DO 270 J=1,N
        Q=1.0D0+DBLE(J)/1.0D1
        DO 260 I=J-2,J+2
          IF (I.LT.1.OR.I.GT.N) GO TO 260
          A=5.0D0*(1.0D0+MOD(I,5)+MOD(J,5))
          B=1.0D0+DBLE(I)/1.0D1
          C=DBLE(I+J)/1.0D1
          P=A*COS(Q*X(J)+B*X(I)+C)/DBLE(N)
          G(J)=G(J)+P*Q
          G(I)=G(I)+P*B
  260   CONTINUE
        IF (J.GT.K) THEN
          I=J-K
          A=5.0D0*(1.0D0+MOD(I,5)+MOD(J,5))
          B=1.0D0+DBLE(I)/1.0D1
          C=DBLE(I+J)/1.0D1
          P=A*COS(Q*X(J)+B*X(I)+C)/DBLE(N)
          G(J)=G(J)+P*Q
          G(I)=G(I)+P*B
        ELSE
          I=J+K
          A=5.0D0*(1.0D0+MOD(I,5)+MOD(J,5))
          B=1.0D0+DBLE(I)/1.0D1
          C=DBLE(I+J)/1.0D1
          P=A*COS(Q*X(J)+B*X(I)+C)/DBLE(N)
          G(J)=G(J)+P*Q
          G(I)=G(I)+P*B
        END IF
  270 CONTINUE
      RETURN
  280 P=-0.2008D-2
      Q=-0.1900D-2
      R=-0.0261D-2
      DO 300 I=0,N-5,5
        A=1.0D0
        B=0.0D0
        DO 290 J=1,5
          A=A*X(I+J)
          B=B+X(I+J)**2
  290   CONTINUE
        A=A*EXP(A)
        B=B-1.0D1-P
        C=X(I+2)*X(I+3)-5.0D0*X(I+4)*X(I+5)-Q
        D=X(I+1)**3+X(I+2)**3+1.0D0-R
        G(I+1)=G(I+1)+A/X(I+1)+2.0D1*(2.0D0*B*X(I+1)+3.0D0*D*X(I+1)**2)
        G(I+2)=G(I+2)+A/X(I+2)+2.0D1*(2.0D0*B*X(I+2)+C*X(I+3)+3.0D0*D*
     &   X(I+2)**2)
        G(I+3)=G(I+3)+A/X(I+3)+2.0D1*(2.0D0*B*X(I+3)+C*X(I+2))
        G(I+4)=G(I+4)+A/X(I+4)+2.0D1*(2.0D0*B*X(I+4)-5.0D0*C*X(I+5))
        G(I+5)=G(I+5)+A/X(I+5)+2.0D1*(2.0D0*B*X(I+5)-5.0D0*C*X(I+4))
  300 CONTINUE
      RETURN
  310 DO 320 J=2,N
        A=X(J-1)-3.0D0
        B=X(J-1)-X(J)
        G(J-1)=G(J-1)+2.0D0*A+2.0D0*B+2.0D1*EXP(2.0D1*B)
        G(J)=G(J)-2.0D0*B-2.0D1*EXP(2.0D1*B)
  320 CONTINUE
      RETURN
  330 DO 340 J=2,N
        A=X(J)**2
        B=X(J-1)**2
        C=A+1.0D0
        D=B+1.0D0
        P=0.0D0
        IF (A.GT.P) P=LOG(A)
        Q=0.0D0
        IF (B.GT.Q) Q=LOG(B)
        G(J-1)=G(J-1)+2.0D0*X(J-1)*(C*B**A+P*A**D)
        G(J)=G(J)+2.0D0*X(J)*(D*A**B+Q*B**C)
  340 CONTINUE
      RETURN
  350 P=1.0D0/DBLE(N+1)
      Q=0.5D0*P**2
      DO 360 J=1,N
        A=2.0D0*X(J)+Q*(X(J)+DBLE(J)*P+1.0D0)**3
        IF (J.GT.1) A=A-X(J-1)
        IF (J.LT.N) A=A-X(J+1)
        G(J)=G(J)+A*(4.0D0+6.0D0*Q*(X(J)+DBLE(J)*P+1.0D0)**2.0D0)
        IF (J.GT.1) G(J-1)=G(J-1)-2.0D0*A
        IF (J.LT.N) G(J+1)=G(J+1)-2.0D0*A
  360 CONTINUE
      RETURN
  370 P=1.0D0/DBLE(N+1)
      Q=2.0D0/P
      R=2.0D0*P
      DO 380 J=2,N
        A=X(J-1)-X(J)
        G(J-1)=G(J-1)+Q*(2.0D0*X(J-1)-X(J))
        G(J)=G(J)-Q*X(J-1)
        IF (ABS(A).LE.1.0D-6) THEN
          G(J-1)=G(J-1)+R*EXP(X(J))*(1.0D0/2.0D0+A*(1.0D0/3.0D0+A/8.0D0)
     &     )
          G(J)=G(J)+R*EXP(X(J))*(1.0D0/2.0D0+A*(1.0D0/6.0D0+A/24.0D0))
        ELSE
          B=EXP(X(J-1))-EXP(X(J))
          G(J-1)=G(J-1)+R*(EXP(X(J-1))*A-B)/A**2
          G(J)=G(J)-R*(EXP(X(J))*A-B)/A**2
        END IF
  380 CONTINUE
      G(1)=G(1)+R*(EXP(X(1))*(X(1)-1.0D0)+1.0D0)/X(1)**2
      G(N)=G(N)+2.0D0*Q*X(N)+R*(EXP(X(N))*(X(N)-1.0D0)+1.0D0)/X(N)**2
      RETURN
  390 DO 400 J=1,N
        A=DBLE(J)*SIN(X(J))
        G(J)=G(J)+A
        IF (J.GT.1) G(J-1)=G(J-1)+DBLE(J)*COS(X(J-1))
        IF (J.LT.N) G(J+1)=G(J+1)-DBLE(J)*COS(X(J+1))
  400 CONTINUE
      RETURN
  410 P=1.0D0/DBLE(N+1)
      DO 420 J=1,N
        IF (J.EQ.1) THEN
          G(J)=G(J)+0.5D0*X(J)/P+P*EXP(X(J))
          G(J+1)=G(J+1)+0.25D0*X(J+1)/P
        ELSE IF (J.EQ.N) THEN
          G(J)=G(J)+0.5D0*X(J)/P+P*EXP(X(J))
          G(J-1)=G(J-1)+0.25D0*X(J-1)/P
        ELSE
          A=0.25D0*(X(J+1)-X(J-1))/P
          G(J)=G(J)+P*EXP(X(J))
          G(J-1)=G(J-1)-A
          G(J+1)=G(J+1)+A
        END IF
  420 CONTINUE
      RETURN
  430 P=1.0D0/DBLE(N+1)
      DO 440 J=1,N
        Q=DBLE(J)*P
        IF (J.EQ.1) THEN
          G(J)=G(J)+X(J)/P-2.0D0*P*(X(J)+Q)
          G(J+1)=G(J+1)+0.5D0*X(J+1)/P
        ELSE IF (J.EQ.N) THEN
          G(J)=G(J)+X(J)/P-2.0D0*P*(X(J)+Q)
          G(J-1)=G(J-1)+0.5D0*X(J-1)/P
        ELSE
          A=0.5D0*(X(J+1)-X(J-1))/P
          G(J)=G(J)-2.0D0*P*(X(J)+Q)
          G(J-1)=G(J-1)-A
          G(J+1)=G(J+1)+A
        END IF
  440 CONTINUE
      RETURN
  450 P=1.0D0/DBLE(N+1)
      DO 460 J=1,N
        Q=EXP(2.0D0*DBLE(J)*P)
        IF (J.EQ.1) THEN
          R=1.0D0/3.0D0
          A=0.5D0*(X(J+1)-R)/P
          G(J)=G(J)+2.0D0*P*(X(J)+Q)+(X(J)-R)/P
          G(J+1)=G(J+1)+A
        ELSE IF (J.EQ.N) THEN
          R=EXP(2.0D0)/3.0D0
          A=0.5D0*(X(J-1)-R)/P
          G(J)=G(J)+2.0D0*P*(X(J)+Q)+(X(J)-R)/P
          G(J-1)=G(J-1)+A
        ELSE
          A=0.5D0*(X(J+1)-X(J-1))/P
          G(J)=G(J)+2.0D0*P*(X(J)+Q)
          G(J-1)=G(J-1)-A
          G(J+1)=G(J+1)+A
        END IF
  460 CONTINUE
      RETURN
  470 P=1.0D0/DBLE(N+1)
      DO 480 J=1,N
        A=EXP(-2.0D0*X(J)**2)
        IF (J.EQ.1) THEN
          B=0.5D0*X(J+1)/P
          G(J)=G(J)+X(J)/P-4.0D0*X(J)*A*P*(B**2-1.0D0)
          G(J+1)=G(J+1)+A*B
        ELSE IF (J.EQ.N) THEN
          B=0.5D0*X(J-1)/P
          G(J)=G(J)+X(J)/P*EXP(-2.0D0)-4.0D0*X(J)*A*P*(B**2-1.0D0)
          G(J-1)=G(J-1)+A*B
        ELSE
          B=0.5D0*(X(J+1)-X(J-1))/P
          G(J)=G(J)-4.0D0*X(J)*A*P*(B**2-1.0D0)
          G(J-1)=G(J-1)-A*B
          G(J+1)=G(J+1)+A*B
        END IF
  480 CONTINUE
      RETURN
  490 P=1.0D0/DBLE(N+1)
      DO 500 J=1,N
        IF (J.EQ.1) THEN
          A=0.5D0*(X(J+1)-1.0D0)/P
          B=(X(J)-1.0D0)/P
          U=0.5D0*ATAN(A)
          V=0.5D0*ATAN(B)
          G(J)=G(J)+2.0D0*P*X(J)+V
          G(J+1)=G(J+1)+U
        ELSE IF (J.EQ.N) THEN
          A=0.5D0*(2.0D0-X(J-1))/P
          B=(2.0D0-X(J))/P
          U=0.5D0*ATAN(A)
          V=0.5D0*ATAN(B)
          G(J)=G(J)+2.0D0*P*X(J)-V
          G(J-1)=G(J-1)-U
        ELSE
          A=0.5D0*(X(J+1)-X(J-1))/P
          U=0.5D0*ATAN(A)
          G(J)=G(J)+2.0D0*P*X(J)
          G(J-1)=G(J-1)-U
          G(J+1)=G(J+1)+U
        END IF
  500 CONTINUE
      RETURN
  510 P=1.0D0/DBLE(N+1)
      DO 520 J=1,N
        IF (J.EQ.1) THEN
          A=0.5D0*X(J+1)/P
          B=X(J)/P
          G(J)=G(J)+2.0D2*P*(X(J)-A**2)+2.0D2*B**3-(1.0D0-B)
          G(J+1)=G(J+1)-2.0D2*(X(J)-A**2)*A-(1.0D0-A)
        ELSE IF (J.EQ.N) THEN
          A=-0.5D0*X(J-1)/P
          B=-X(J)/P
          G(J)=G(J)+2.0D2*P*(X(J)-A**2)-2.0D2*B**3+(1.0D0-B)
          G(J-1)=G(J-1)+2.0D2*(X(J)-A**2)*A+(1.0D0-A)
        ELSE
          A=0.5D0*(X(J+1)-X(J-1))/P
          G(J)=G(J)+2.0D2*P*(X(J)-A**2)
          G(J-1)=G(J-1)+2.0D2*(X(J)-A**2)*A+(1.0D0-A)
          G(J+1)=G(J+1)-2.0D2*(X(J)-A**2)*A-(1.0D0-A)
        END IF
  520 CONTINUE
      RETURN
      END
! SUBROUTINE TIUB15                ALL SYSTEMS                92/12/01
! PORTABILITY : ALL SYSTEMS
! 92/12/01 RA : ORIGINAL VERSION
!
! PURPOSE :
!  INITIATION OF VARIABLES AND DEFINITION OF STRUCTURE OF THE SPARSE
!  JACOBIAN MATRIX FOR THE SUM OF SQUARES.
!
! PARAMETERS :
!  IU  N  NUMBER OF VARIABLES.
!  IO  NA  NUMBER OF PARTIAL FUNCTIONS.
!  IO  MA  NUMBER OF NONZERO ELEMENTS IN THE SPARSE JACOBIAN MATRIX.
!  RO  X(N)  VECTOR OF VARIABLES.
!  IO  IA(NA+1)  POINTERS OF FIRST IN THE ROW ELEMENTS IN THE
!         SPARSE JACOBIAN MATRIX.
!  IO  JA(MA)  COLUMN INDICES OF NONZERO ELEMENTS IN THE SPARSE
!         JACOBIAN MATRIX.
!  RO  FMIN  LOWER BOUND FOR THE OBJECTIVE FUNCTION VALUE.
!  RO  XMAX  MAXIMUM ALLOWED STEPSIZE.
!  II  NEXT  NUMBER OF THE SELECTED TEST PROBLEM.
!  IO  IERR  ERROR INDICATOR. IERR=0 FOR CORRECT OUTPUT.
!
      SUBROUTINE TIUB15 (N, NA, MA, X, IA, JA, FMIN, XMAX, NEXT, IERR)
      INTEGER N,NA,MA,NEXT,IERR
      INTEGER IA(*),JA(*)
      DOUBLE PRECISION X(*),FMIN,XMAX
      INTEGER I,J,K,L,II,JJ,KK,LL,MM,KA
      DOUBLE PRECISION Y(20)
      COMMON /EMPR15/ Y
      DOUBLE PRECISION ETA9
      PARAMETER  (ETA9=1.0D60)
      FMIN=0.0D0
      XMAX=1.0D3
      IERR=0
      GO TO (10,40,70,100,130,160,230,250,280,320,350,380,410,440,500,
     &520,540,560,580,600,620,650),NEXT
   10 IF (N.LT.2) GO TO 680
      N=N-MOD(N,2)
      DO 20 I=1,N
        IF (MOD(I,2).EQ.1) THEN
          X(I)=-1.2D0
        ELSE
          X(I)=1.0D0
        END IF
   20 CONTINUE
      DO 30 I=1,N-1
        L=3*(I-1)+1
        JA(L)=I
        JA(L+1)=I+1
        JA(L+2)=I
        K=2*(I-1)+1
        IA(K)=L
        IA(K+1)=L+2
   30 CONTINUE
      IA(K+2)=L+3
      NA=2*(N-1)
      MA=3*(N-1)
      RETURN
   40 IF (N.LT.4) GO TO 680
      N=N-MOD(N,2)
      DO 50 I=1,N
        IF (MOD(I,2).EQ.1) THEN
          X(I)=-2.0D0
          IF (I.LE.4) X(I)=-3.0D0
        ELSE
          X(I)=0.0D0
          IF (I.LE.4) X(I)=-1.0D0
        END IF
   50 CONTINUE
      DO 60 I=2,N-2,2
        L=5*(I-2)+1
        JA(L)=I-1
        JA(L+1)=I
        JA(L+2)=I-1
        JA(L+3)=I+1
        JA(L+4)=I+2
        JA(L+5)=I+1
        JA(L+6)=I
        JA(L+7)=I+2
        JA(L+8)=I
        JA(L+9)=I+2
        K=3*(I-2)+1
        IA(K)=L
        IA(K+1)=L+2
        IA(K+2)=L+3
        IA(K+3)=L+5
        IA(K+4)=L+6
        IA(K+5)=L+8
   60 CONTINUE
      IA(K+6)=L+10
      NA=K+5
      MA=L+9
      RETURN
   70 IF (N.LT.4) GO TO 680
      N=N-MOD(N,2)
      DO 80 I=1,N
        IF (MOD(I,4).EQ.1) THEN
          X(I)=3.0D0
        ELSE IF (MOD(I,4).EQ.2) THEN
          X(I)=-1.0D0
        ELSE IF (MOD(I,4).EQ.3) THEN
          X(I)=0.0D0
        ELSE
          X(I)=1.0D0
        END IF
   80 CONTINUE
      DO 90 I=2,N-2,2
        L=4*(I-2)+1
        JA(L)=I-1
        JA(L+1)=I
        JA(L+2)=I+1
        JA(L+3)=I+2
        JA(L+4)=I
        JA(L+5)=I+1
        JA(L+6)=I-1
        JA(L+7)=I+2
        K=2*(I-2)+1
        IA(K)=L
        IA(K+1)=L+2
        IA(K+2)=L+4
        IA(K+3)=L+6
   90 CONTINUE
      IA(K+4)=L+8
      NA=K+3
      MA=L+7
      RETURN
  100 IF (N.LT.4) GO TO 680
      N=N-MOD(N,2)
      DO 110 I=1,N
        X(I)=2.0D0
  110 CONTINUE
      X(1)=1.0D0
      DO 120 I=2,N-2,2
        L=4*(I-2)+1
        JA(L)=I-1
        JA(L+1)=I
        JA(L+2)=I
        JA(L+3)=I+1
        JA(L+4)=I+1
        JA(L+5)=I+2
        JA(L+6)=I-1
        JA(L+7)=I+2
        K=5*(I-2)/2+1
        IA(K)=L
        IA(K+1)=L+2
        IA(K+2)=L+4
        IA(K+3)=L+6
        IA(K+4)=L+7
  120 CONTINUE
      IA(K+5)=L+8
      NA=K+4
      MA=L+7
      XMAX=1.0D1
      RETURN
  130 IF (N.LT.3) GO TO 680
      DO 140 I=1,N
        X(I)=-1.0D0
  140 CONTINUE
      JA(1)=1
      JA(2)=2
      IA(1)=1
      DO 150 I=2,N-1
        K=3*(I-2)+3
        JA(K)=I-1
        JA(K+1)=I
        JA(K+2)=I+1
        IA(I)=K
  150 CONTINUE
      JA(K+3)=N-1
      JA(K+4)=N
      IA(N)=K+3
      IA(N+1)=IA(N)+2
      NA=N
      MA=3*N-2
      RETURN
  160 IF (N.LT.6) GO TO 680
      DO 170 I=1,N
        X(I)=-1.0D0
  170 CONTINUE
      L=1
      DO 190 I=1,5
        IA(I)=L
        DO 180 K=1,I+1
          JA(L)=K
          L=L+1
  180   CONTINUE
  190 CONTINUE
      DO 210 I=6,N-1
        IA(I)=L
        DO 200 K=I-5,I+1
          JA(L)=K
          L=L+1
  200   CONTINUE
  210 CONTINUE
      IA(N)=L
      DO 220 K=N-5,N
        JA(L)=K
        L=L+1
  220 CONTINUE
      IA(N+1)=L
      NA=N
      MA=L-1
      RETURN
  230 IF (N.LT.2) GO TO 680
      DO 240 I=1,N-1
        X(I)=0.5D0
        K=4*(I-1)+1
        JA(K)=I
        JA(K+1)=I+1
        JA(K+2)=I
        JA(K+3)=I+1
        L=2*(I-1)+1
        IA(L)=K
        IA(L+1)=K+2
  240 CONTINUE
      X(N)=-2.0D0
      IA(L+2)=IA(L+1)+2
      NA=2*(N-1)
      MA=2*NA
      RETURN
  250 IF (N.LT.4) GO TO 680
      N=N-MOD(N,4)
      DO 260 I=1,N
        X(I)=SIN(DBLE(I))**2
  260 CONTINUE
      MM=5*N
      K=1
      DO 270 KA=1,MM
        I=MOD(KA,N/2)+1
        J=I+N/2
        K=2*(KA-1)+1
        JA(K)=I
        JA(K+1)=J
        IA(KA)=K
  270 CONTINUE
      IA(MM+1)=K+2
      NA=MM
      MA=2*MM
      RETURN
  280 IF (N.LT.4) GO TO 680
      N=N-MOD(N,2)
      DO 290 I=1,N
        X(I)=5.0D0
  290 CONTINUE
      DO 310 I=2,N-2,2
        L=12*(I-2)+1
        DO 300 J=1,6
          K=(J-1)*4
          JA(L+K)=I-1
          JA(L+K+1)=I
          JA(L+K+2)=I+1
          JA(L+K+3)=I+2
  300   CONTINUE
        K=3*(I-2)+1
        IA(K)=L
        IA(K+1)=L+4
        IA(K+2)=L+8
        IA(K+3)=L+12
        IA(K+4)=L+16
        IA(K+5)=L+20
  310 CONTINUE
      IA(K+6)=L+24
      NA=K+5
      MA=L+23
      RETURN
  320 IF (N.LT.2) GO TO 680
      DO 330 I=1,N
        X(I)=0.2D0
  330 CONTINUE
      MM=2*N-2
      JA(1)=1
      JA(2)=2
      JA(3)=1
      JA(4)=2
      IA(1)=1
      IA(2)=3
      K=5
      L=3
      DO 340 KA=3,MM,2
        I=(KA+1)/2-1
        JA(K)=I
        JA(K+1)=I+1
        JA(K+2)=I+2
        JA(K+3)=I+1
        JA(K+4)=I+2
        IA(L)=K
        IA(L+1)=K+3
        K=K+5
        L=L+2
  340 CONTINUE
      JA(K)=N-1
      JA(K+1)=N
      IA(L)=K
      IA(L+1)=K+2
      NA=L
      MA=K+1
      RETURN
  350 CONTINUE
      IF (N.LT.2) GO TO 680
      N=N-MOD(N,2)
      DO 360 I=1,N
        IF (MOD(I,2).EQ.1) THEN
          X(I)=-0.8D0
        ELSE
          X(I)=-0.8D0
        END IF
  360 CONTINUE
      IA(1)=1
      NA=2*(N-1)
      MA=1
      L=1
      DO 370 K=1,N-1
        JA(MA)=K
        MA=MA+1
        JA(MA)=K+1
        MA=MA+1
        L=L+1
        IA(L)=MA
        JA(MA)=K
        MA=MA+1
        L=L+1
        IA(L)=MA
  370 CONTINUE
      MA=IA(NA+1)-1
      RETURN
  380 CONTINUE
      IF (N.LT.5) GO TO 680
      IF (MOD(N-5,3).NE.0) N=N-MOD(N-5,3)
      DO 390 I=1,N
        X(I)=-1.0D0
  390 CONTINUE
      IA(1)=1
      KK=(N-5)/3+1
      NA=6*KK
      MA=1
      L=1
      DO 400 K=1,KK
        I=3*(K-1)+1
        JA(MA)=I
        MA=MA+1
        JA(MA)=I+1
        MA=MA+1
        L=L+1
        IA(L)=MA
        JA(MA)=I+2
        MA=MA+1
        L=L+1
        IA(L)=MA
        JA(MA)=I+3
        MA=MA+1
        L=L+1
        IA(L)=MA
        JA(MA)=I+4
        MA=MA+1
        L=L+1
        IA(L)=MA
        JA(MA)=I
        MA=MA+1
        JA(MA)=I+3
        MA=MA+1
        JA(MA)=I+4
        MA=MA+1
        L=L+1
        IA(L)=MA
        JA(MA)=I+1
        MA=MA+1
        JA(MA)=I+2
        MA=MA+1
        JA(MA)=I+3
        MA=MA+1
        L=L+1
        IA(L)=MA
  400 CONTINUE
      MA=IA(NA+1)-1
      RETURN
  410 CONTINUE
      IF (N.LT.5) GO TO 680
      IF (MOD(N-5,3).NE.0) N=N-MOD(N-5,3)
      DO 420 I=1,N
        X(I)=-1.0D0
  420 CONTINUE
      IA(1)=1
      KK=(N-5)/3+1
      NA=7*KK
      MA=1
      L=1
      DO 430 K=1,KK
        I=3*(K-1)+1
        JA(MA)=I
        MA=MA+1
        JA(MA)=I+1
        MA=MA+1
        L=L+1
        IA(L)=MA
        JA(MA)=I+1
        MA=MA+1
        JA(MA)=I+2
        MA=MA+1
        L=L+1
        IA(L)=MA
        JA(MA)=I+2
        MA=MA+1
        JA(MA)=I+3
        MA=MA+1
        L=L+1
        IA(L)=MA
        JA(MA)=I+3
        MA=MA+1
        JA(MA)=I+4
        MA=MA+1
        L=L+1
        IA(L)=MA
        JA(MA)=I
        MA=MA+1
        JA(MA)=I+1
        MA=MA+1
        JA(MA)=I+2
        MA=MA+1
        L=L+1
        IA(L)=MA
        JA(MA)=I+1
        MA=MA+1
        JA(MA)=I+2
        MA=MA+1
        JA(MA)=I+3
        MA=MA+1
        L=L+1
        IA(L)=MA
        JA(MA)=I
        MA=MA+1
        JA(MA)=I+4
        MA=MA+1
        L=L+1
        IA(L)=MA
  430 CONTINUE
      MA=IA(NA+1)-1
      RETURN
  440 CONTINUE
      IF (N.LT.4) GO TO 680
      DO 450 I=1,N
        IF (MOD(I,4).EQ.1) THEN
          X(I)=-0.8D0
        ELSE IF (MOD(I,4).EQ.2) THEN
          X(I)=1.2D0
        ELSE IF (MOD(I,4).EQ.3) THEN
          X(I)=-1.2D0
        ELSE
          X(I)=0.8D0
        END IF
  450 CONTINUE
      Y(1)=14.4D0
      Y(2)=6.8D0
      Y(3)=4.2D0
      Y(4)=3.2D0
      II=4
      JJ=4
      LL=2
      IA(1)=1
  460 IF (MOD(N-II,LL).NE.0) N=N-MOD(N-II,LL)
      KK=(N-II)/LL+1
      NA=JJ*KK
      MA=1
      L=1
      DO 490 K=1,KK
        MM=(K-1)*LL
        DO 480 J=1,JJ
          DO 470 I=1,II
            JA(MA)=MM+I
            MA=MA+1
  470     CONTINUE
          L=L+1
          IA(L)=MA
  480   CONTINUE
  490 CONTINUE
      MA=IA(NA+1)-1
      RETURN
  500 CONTINUE
      IF (N.LT.4) GO TO 680
      DO 510 I=1,N
        IF (MOD(I,4).EQ.1) THEN
          X(I)=-0.8D0
        ELSE IF (MOD(I,4).EQ.2) THEN
          X(I)=1.2D0
        ELSE IF (MOD(I,4).EQ.3) THEN
          X(I)=-1.2D0
        ELSE
          X(I)=0.8D0
        END IF
  510 CONTINUE
      Y(1)=35.8D0
      Y(2)=11.2D0
      Y(3)=6.2D0
      Y(4)=4.4D0
      II=4
      JJ=4
      LL=2
      IA(1)=1
      GO TO 460
  520 CONTINUE
      IF (N.LT.4) GO TO 680
      DO 530 I=1,N
        IF (MOD(I,4).EQ.1) THEN
          X(I)=-0.8D0
        ELSE IF (MOD(I,4).EQ.2) THEN
          X(I)=1.2D0
        ELSE IF (MOD(I,4).EQ.3) THEN
          X(I)=-1.2D0
        ELSE
          X(I)=0.8D0
        END IF
  530 CONTINUE
      Y(1)=30.6D0
      Y(2)=72.2D0
      Y(3)=124.4D0
      Y(4)=187.4D0
      II=4
      JJ=4
      LL=2
      IA(1)=1
      GO TO 460
  540 IF (N.LT.4) GO TO 680
      N=N-MOD(N,2)
      NA=N
      MA=0
      IA(1)=1
      DO 550 I=1,N
        IF (MOD(I,8).EQ.1) X(I)=1.0D-1
        IF (MOD(I,8).EQ.2.OR.MOD(I,8).EQ.0) X(I)=2.0D-1
        IF (MOD(I,8).EQ.3.OR.MOD(I,8).EQ.7) X(I)=3.0D-1
        IF (MOD(I,8).EQ.4.OR.MOD(I,8).EQ.6) X(I)=4.0D-1
        IF (MOD(I,8).EQ.5) X(I)=5.0D-1
        IF (I.GT.2) THEN
          MA=MA+1
          JA(MA)=I-2
        END IF
        MA=MA+2
        IF (MOD(I,2).EQ.1) THEN
          JA(MA-1)=I
          JA(MA)=I+1
        ELSE
          JA(MA-1)=I-1
          JA(MA)=I
        END IF
        IF (I.LT.N-1) THEN
          MA=MA+1
          JA(MA)=I+2
        END IF
        IA(I+1)=MA+1
  550 CONTINUE
      RETURN
  560 IF (N.LT.3) GO TO 680
      NA=N
      MA=0
      IA(1)=1
      DO 570 I=1,N
        X(I)=1.2D1
        IF (I.GT.1) THEN
          MA=MA+1
          JA(MA)=I-1
        END IF
        MA=MA+1
        JA(MA)=I
        IF (I.LT.N) THEN
          MA=MA+1
          JA(MA)=I+1
        END IF
        IA(I+1)=MA+1
  570 CONTINUE
      RETURN
  580 IF (N.LT.7) GO TO 680
      NA=N
      MA=0
      IA(1)=1
      DO 590 I=1,N
        X(I)=-1.0D0
        IF (I.GT.1.AND.I.LT.N-3) THEN
          MA=MA+1
          JA(MA)=I-1
        END IF
        IF (I.LT.N-4) THEN
          MA=MA+1
          JA(MA)=I
        END IF
        IF (I.LT.N-5) THEN
          MA=MA+1
          JA(MA)=I+1
        END IF
        MA=MA+5
        JA(MA-4)=N-4
        JA(MA-3)=N-3
        JA(MA-2)=N-2
        JA(MA-1)=N-1
        JA(MA)=N
        IA(I+1)=MA+1
  590 CONTINUE
      RETURN
  600 IF (N.LT.3) GO TO 680
      NA=N
      MA=0
      IA(1)=1
      DO 610 I=1,N
        X(I)=DBLE(I)/DBLE(N+1)
        X(I)=X(I)*(X(I)-1.0D0)
        IF (I.GT.1) THEN
          MA=MA+1
          JA(MA)=I-1
        END IF
        MA=MA+1
        JA(MA)=I
        IF (I.LT.N) THEN
          MA=MA+1
          JA(MA)=I+1
        END IF
        IA(I+1)=MA+1
  610 CONTINUE
      RETURN
  620 CONTINUE
      IF (N.LT.5) GO TO 680
      IF (MOD(N-5,3).NE.0) N=N-MOD(N-5,3)
      DO 630 I=1,N
        X(I)=-1.0D0
  630 CONTINUE
      IA(1)=1
      KK=(N-5)/3+1
      NA=7*KK
      MA=1
      L=1
      DO 640 K=1,KK
        I=3*(K-1)+1
        JA(MA)=I
        MA=MA+1
        JA(MA)=I+1
        MA=MA+1
        L=L+1
        IA(L)=MA
        JA(MA)=I+1
        MA=MA+1
        JA(MA)=I+2
        MA=MA+1
        L=L+1
        IA(L)=MA
        JA(MA)=I+3
        MA=MA+1
        L=L+1
        IA(L)=MA
        JA(MA)=I+4
        MA=MA+1
        L=L+1
        IA(L)=MA
        JA(MA)=I
        MA=MA+1
        JA(MA)=I+1
        MA=MA+1
        L=L+1
        IA(L)=MA
        JA(MA)=I+2
        MA=MA+1
        JA(MA)=I+3
        MA=MA+1
        JA(MA)=I+4
        MA=MA+1
        L=L+1
        IA(L)=MA
        JA(MA)=I+1
        MA=MA+1
        JA(MA)=I+4
        MA=MA+1
        L=L+1
        IA(L)=MA
  640 CONTINUE
      MA=IA(NA+1)-1
      RETURN
  650 IF (N.LT.3) GO TO 680
      DO 660 I=1,N
        IF (MOD(I,2).EQ.1) THEN
          X(I)=-1.2D0
        ELSE
          X(I)=1.0D0
        END IF
  660 CONTINUE
      NA=2*(N-1)
      MA=2
      IA(1)=1
      IA(2)=2
      JA(1)=1
      DO 670 KA=1,NA-1
        I=(KA+1)/2
        IF (MOD(KA,2).EQ.1) THEN
          JA(MA)=I
          MA=MA+1
          JA(MA)=I+1
          MA=MA+1
        ELSE
          JA(MA)=I
          MA=MA+1
          JA(MA)=I+1
          MA=MA+1
          JA(MA)=I+2
          MA=MA+1
        END IF
        IA(KA+2)=MA
  670 CONTINUE
      MA=MA-1
      RETURN
  680 IERR=1
      RETURN
      END
! SUBROUTINE TAFU15             ALL SYSTEMS                92/12/01
! PORTABILITY : ALL SYSTEMS
! 92/12/01 RA : ORIGINAL VERSION
!
! PURPOSE :
!  VALUES OF PARTIAL FUNCTIONS IN THE SUM OF SQUARES.
!
! PARAMETERS :
!  II  N  NUMBER OF VARIABLES.
!  II  KA  INDEX OF THE GIVEN PARTIAL FUNCTION.
!  RI  X(N)  VECTOR OF VARIABLES.
!  RO  FA  VALUE OF THE KA-TH PARTIAL FUNCTION AT THE POINT X.
!  II  NEXT  NUMBER OF THE SELECTED TEST PROBLEM.
!
      SUBROUTINE TAFU15 (N, KA, X, FA, NEXT)
      INTEGER N,KA,NEXT
      DOUBLE PRECISION X(*),FA
      DOUBLE PRECISION A,C,D,P,ALFA,U,V
      INTEGER I,J,K,L,M,IA,IB,IC
      DOUBLE PRECISION Y(20)
      COMMON /EMPR15/ Y
      GO TO (10,20,30,40,50,60,80,90,100,110,120,130,140,150,180,210,
     &230,240,250,260,270,280),NEXT
   10 I=(KA+1)/2
      IF (MOD(KA,2).EQ.1) THEN
        FA=1.0D1*(X(I)**2-X(I+1))
      ELSE
        FA=X(I)-1.0D0
      END IF
      RETURN
   20 A=SQRT(10.0D0)
      D=SQRT(90.0D0)
      I=2*((KA+5)/6)
      IF (MOD(KA,6).EQ.1) THEN
        FA=1.0D1*(X(I-1)**2-X(I))
      ELSE IF (MOD(KA,6).EQ.2) THEN
        FA=X(I-1)-1.0D0
      ELSE IF (MOD(KA,6).EQ.3) THEN
        FA=D*(X(I+1)**2-X(I+2))
      ELSE IF (MOD(KA,6).EQ.4) THEN
        FA=X(I+1)-1.0D0
      ELSE IF (MOD(KA,6).EQ.5) THEN
        FA=A*(X(I)+X(I+2)-2.0D0)
      ELSE
        FA=(X(I)-X(I+2))/A
      END IF
      RETURN
   30 A=SQRT(1.0D1)
      C=SQRT(5.0D0)
      I=2*((KA+3)/4)
      IF (MOD(KA,4).EQ.1) THEN
        FA=X(I-1)+1.0D1*X(I)
      ELSE IF (MOD(KA,4).EQ.2) THEN
        FA=C*(X(I+1)-X(I+2))
      ELSE IF (MOD(KA,4).EQ.3) THEN
        FA=(X(I)-2.0D0*X(I+1))**2
      ELSE
        FA=A*(X(I-1)-X(I+2))**2
      END IF
      RETURN
   40 I=2*((KA+4)/5)
      IF (MOD(KA,5).EQ.1) THEN
        FA=(EXP(X(I-1))-X(I))**2
      ELSE IF (MOD(KA,5).EQ.2) THEN
        FA=1.0D1*(X(I)-X(I+1))**3
      ELSE IF (MOD(KA,5).EQ.3) THEN
        P=X(I+1)-X(I+2)
        FA=(SIN(P)/COS(P))**2
      ELSE IF (MOD(KA,5).EQ.4) THEN
        FA=X(I-1)**4
      ELSE
        FA=X(I+2)-1.0D0
      END IF
      RETURN
   50 I=KA
      FA=(3.0D0-2.0D0*X(I))*X(I)+1.0D0
      IF (I.GT.1) FA=FA-X(I-1)
      IF (I.LT.N) FA=FA-X(I+1)
      RETURN
   60 I=KA
      FA=(2.0D0+5.0D0*X(I)**2)*X(I)+1.0D0
      DO 70 J=MAX(1,I-5),MIN(N,I+1)
        FA=FA+X(J)*(1.0D0+X(J))
   70 CONTINUE
      RETURN
   80 I=(KA+1)/2
      IF (MOD(KA,2).EQ.1) THEN
        FA=X(I)+X(I+1)*((5.0D0-X(I+1))*X(I+1)-2.0D0)-1.3D1
      ELSE
        FA=X(I)+X(I+1)*((1.0D0+X(I+1))*X(I+1)-1.4D1)-2.9D1
      END IF
      RETURN
   90 I=MOD(KA,N/2)+1
      J=I+N/2
      M=5*N
      IF (KA.LE.M/2) THEN
        IA=1
      ELSE
        IA=2
      END IF
      IB=5-KA/(M/4)
      IC=MOD(KA,5)+1
      FA=(X(I)**IA-X(J)**IB)**IC
      RETURN
  100 I=2*((KA+5)/6)-1
      IF (MOD(KA,6).EQ.1) THEN
        FA=X(I)+3.0D0*X(I+1)*(X(I+2)-1.0D0)+X(I+3)**2-1.0D0
      ELSE IF (MOD(KA,6).EQ.2) THEN
        FA=(X(I)+X(I+1))**2+(X(I+2)-1.0D0)**2-X(I+3)-3.0D0
      ELSE IF (MOD(KA,6).EQ.3) THEN
        FA=X(I)*X(I+1)-X(I+2)*X(I+3)
      ELSE IF (MOD(KA,6).EQ.4) THEN
        FA=2.0D0*X(I)*X(I+2)+X(I+1)*X(I+3)-3.0D0
      ELSE IF (MOD(KA,6).EQ.5) THEN
        FA=(X(I)+X(I+1)+X(I+2)+X(I+3))**2+(X(I)-1.0D0)**2
      ELSE
        FA=X(I)*X(I+1)*X(I+2)*X(I+3)+(X(I+3)-1.0D0)**2-1.0D0
      END IF
      RETURN
  110 I=(KA+1)/2
      J=MOD(KA,2)
      IF (J.EQ.0) THEN
        FA=6.0D0-EXP(2.0D0*X(I))-EXP(2.0D0*X(I+1))
      ELSE IF (I.EQ.1) THEN
        FA=4.0D0-EXP(X(I))-EXP(X(I+1))
      ELSE IF (I.EQ.N) THEN
        FA=8.0D0-EXP(3.0D0*X(I-1))-EXP(3.0D0*X(I))
      ELSE
        FA=8.0D0-EXP(3.0D0*X(I-1))-EXP(3.0D0*X(I))+4.0D0-EXP(X(I))-
     &   EXP(X(I+1))
      END IF
      RETURN
  120 I=(KA+1)/2
      IF (MOD(KA,2).EQ.1) THEN
        FA=1.0D1*(2.0D0*X(I)/(1.0D0+X(I)**2)-X(I+1))
      ELSE
        FA=X(I)-1.0D0
      END IF
      RETURN
  130 I=3*((KA+5)/6)-2
      IF (MOD(KA,6).EQ.1) THEN
        FA=1.0D1*(X(I)**2-X(I+1))
      ELSE IF (MOD(KA,6).EQ.2) THEN
        FA=X(I+2)-1.0D0
      ELSE IF (MOD(KA,6).EQ.3) THEN
        FA=(X(I+3)-1.0D0)**2
      ELSE IF (MOD(KA,6).EQ.4) THEN
        FA=(X(I+4)-1.0D0)**3
      ELSE IF (MOD(KA,6).EQ.5) THEN
        FA=X(I)**2*X(I+3)+SIN(X(I+3)-X(I+4))-1.0D1
      ELSE
        FA=X(I+1)+(X(I+2)**2*X(I+3))**2-2.0D1
      END IF
      RETURN
  140 I=3*((KA+6)/7)-2
      IF (MOD(KA,7).EQ.1) THEN
        FA=1.0D1*(X(I)**2-X(I+1))
      ELSE IF (MOD(KA,7).EQ.2) THEN
        FA=1.0D1*(X(I+1)**2-X(I+2))
      ELSE IF (MOD(KA,7).EQ.3) THEN
        FA=(X(I+2)-X(I+3))**2
      ELSE IF (MOD(KA,7).EQ.4) THEN
        FA=(X(I+3)-X(I+4))**2
      ELSE IF (MOD(KA,7).EQ.5) THEN
        FA=X(I)+X(I+1)**2+X(I+2)-3.0D1
      ELSE IF (MOD(KA,7).EQ.6) THEN
        FA=X(I+1)-X(I+2)**2+X(I+3)-1.0D1
      ELSE
        FA=X(I)*X(I+4)-1.0D1
      END IF
      RETURN
  150 I=2*((KA+3)/4)-2
      L=MOD((KA-1),4)+1
      FA=-Y(L)
      DO 170 K=1,3
        A=DBLE(K*K)/DBLE(L)
        DO 160 J=1,4
          IF (X(I+J).EQ.0) X(I+J)=1.0D-16
          A=A*SIGN(1.0D0,X(I+J))*ABS(X(I+J))**(DBLE(J)/DBLE(K*L))
  160   CONTINUE
        FA=FA+A
  170 CONTINUE
      RETURN
  180 I=2*((KA+3)/4)-2
      L=MOD((KA-1),4)+1
      FA=-Y(L)
      DO 200 K=1,3
        A=0.0D0
        DO 190 J=1,4
          A=A+X(I+J)*(DBLE(J)/DBLE(K*L))
  190   CONTINUE
        FA=FA+EXP(A)*DBLE(K*K)/DBLE(L)
  200 CONTINUE
      RETURN
  210 I=2*((KA+3)/4)-2
      L=MOD((KA-1),4)+1
      FA=-Y(L)
      DO 220 J=1,4
        FA=FA+DBLE((1-2*MOD(J,2))*L*J*J)*SIN(X(I+J))+DBLE(L*L*J)*
     &   COS(X(I+J))
  220 CONTINUE
      RETURN
  230 ALFA=0.5D0
      IF (KA.EQ.1) THEN
        FA=ALFA-(1.0D0-ALFA)*X(3)-X(1)*(1.0D0+4.0D0*X(2))
      ELSE IF (KA.EQ.2) THEN
        FA=-(2.0D0-ALFA)*X(4)-X(2)*(1.0D0+4.0D0*X(1))
      ELSE IF (KA.EQ.N-1) THEN
        FA=ALFA*X(N-3)-X(N-1)*(1.0D0+4.0D0*X(N))
      ELSE IF (KA.EQ.N) THEN
        FA=ALFA*X(N-2)-(2.0D0-ALFA)-X(N)*(1.0D0+4.0D0*X(N-1))
      ELSE IF (MOD(KA,2).EQ.1) THEN
        FA=ALFA*X(KA-2)-(1.0D0-ALFA)*X(KA+2)-X(KA)*(1.0D0+4.0D0*X(KA+1))
      ELSE
        FA=ALFA*X(KA-2)-(2.0D0-ALFA)*X(KA+2)-X(KA)*(1.0D0+4.0D0*X(KA-1))
      END IF
      RETURN
  240 IF (KA.LT.2) THEN
        FA=4.0D0*(X(KA)-X(KA+1)**2)
      ELSE IF (KA.LT.N) THEN
        FA=8.0D0*X(KA)*(X(KA)**2-X(KA-1))-2.0D0*(1.0D0-X(KA))+4.0D0*
     &   (X(KA)-X(KA+1)**2)
      ELSE
        FA=8.0D0*X(KA)*(X(KA)**2-X(KA-1))-2.0D0*(1.0D0-X(KA))
      END IF
      RETURN
  250 IF (KA.EQ.1) THEN
        FA=-2.0D0*X(KA)**2+3.0D0*X(KA)-2.0D0*X(KA+1)+3.0D0*X(N-4)-X(N-3)
     &   -X(N-2)+0.5D0*X(N-1)-X(N)+1.0D0
      ELSE IF (KA.LE.N-1) THEN
        FA=-2.0D0*X(KA)**2+3.0D0*X(KA)-X(KA-1)-2.0D0*X(KA+1)+3.0D0*X(N-
     &   4)-X(N-3)-X(N-2)+0.5D0*X(N-1)-X(N)+1.0D0
      ELSE
        FA=-2.0D0*X(N)**2+3.0D0*X(N)-X(N-1)+3.0D0*X(N-4)-X(N-3)-X(N-2)+
     &   0.5D0*X(N-1)-X(N)+1.0D0
      END IF
      RETURN
  260 U=1.0D0/DBLE(N+1)
      V=DBLE(KA)*U
      FA=2.0D0*X(KA)+0.5D0*U*U*(X(KA)+V+1.0D0)**3+1.0D0
      IF (KA.GT.1) FA=FA-X(KA-1)
      IF (KA.LT.N) FA=FA-X(KA+1)
      RETURN
  270 I=3*((KA+6)/7)-2
      IF (MOD(KA,7).EQ.1) THEN
        FA=1.0D1*(X(I)**2-X(I+1))
      ELSE IF (MOD(KA,7).EQ.2) THEN
        FA=X(I+1)+X(I+2)-2.0D0
      ELSE IF (MOD(KA,7).EQ.3) THEN
        FA=X(I+3)-1.0D0
      ELSE IF (MOD(KA,7).EQ.4) THEN
        FA=X(I+4)-1.0D0
      ELSE IF (MOD(KA,7).EQ.5) THEN
        FA=X(I)+3.0D0*X(I+1)
      ELSE IF (MOD(KA,7).EQ.6) THEN
        FA=X(I+2)+X(I+3)-2.0D0*X(I+4)
      ELSE
        FA=1.0D1*(X(I+1)**2-X(I+4))
      END IF
      RETURN
  280 I=KA/2
      IF (KA.EQ.1) THEN
        FA=X(KA)-1.0D0
      ELSE IF (MOD(KA,2).EQ.0) THEN
        FA=1.0D1*(X(I)**2-X(I+1))
      ELSE
        FA=2.0D0*EXP(-(X(I)-X(I+1))**2)+EXP(-2.0D0*(X(I+1)-X(I+2))**2)
      END IF
      RETURN
      END
! SUBROUTINE TAGU15                ALL SYSTEMS                92/12/01
! PORTABILITY : ALL SYSTEMS
! 92/12/01 RA : ORIGINAL VERSION
!
! PURPOSE :
!  GRADIENTS OF PARTIAL FUNCTIONS IN THE SUM OF SQUARES.
!
! PARAMETERS :
!  II  N  NUMBER OF VARIABLES.
!  II  KA  INDEX OF THE GIVEN PARTIAL FUNCTION.
!  RI  X(N)  VECTOR OF VARIABLES.
!  RO  GA(N)  GRADIENT OF THE KA-TH PARTIAL FUNCTION AT THE POINT X.
!  II  NEXT  NUMBER OF THE SELECTED TEST PROBLEM.
!
      SUBROUTINE TAGU15 (N, KA, X, GA, NEXT)
      INTEGER N,KA,NEXT
      DOUBLE PRECISION X(*),GA(*)
      DOUBLE PRECISION A,B,C,D,Q,R,E,ALFA,U,V
      INTEGER I,J,K,L,M,IA,IB,IC
      DOUBLE PRECISION Y(20)
      COMMON /EMPR15/ Y
      GO TO (10,20,30,40,50,60,80,90,100,110,120,130,140,150,200,250,
     &270,280,290,300,310,320,330,340),NEXT
   10 I=(KA+1)/2
      IF (MOD(KA,2).EQ.1) THEN
        GA(I)=2.0D1*X(I)
        GA(I+1)=-1.0D1
      ELSE
        GA(I)=1.0D0
      END IF
      RETURN
   20 I=2*((KA+5)/6)
      A=SQRT(9.0D1)
      B=SQRT(1.0D1)
      IF (MOD(KA,6).EQ.1) THEN
        GA(I-1)=2.0D1*X(I-1)
        GA(I)=-1.0D1
      ELSE IF (MOD(KA,6).EQ.2) THEN
        GA(I-1)=1.0D0
      ELSE IF (MOD(KA,6).EQ.3) THEN
        GA(I+1)=2.0D0*A*X(I+1)
        GA(I+2)=-A
      ELSE IF (MOD(KA,6).EQ.4) THEN
        GA(I+1)=1.0D0
      ELSE IF (MOD(KA,6).EQ.5) THEN
        GA(I)=B
        GA(I+2)=B
      ELSE
        GA(I)=1.0D0/B
        GA(I+2)=-1.0D0/B
      END IF
      RETURN
   30 I=2*((KA+3)/4)
      A=SQRT(5.0D0)
      B=SQRT(1.0D1)
      IF (MOD(KA,4).EQ.1) THEN
        GA(I-1)=1.0D0
        GA(I)=1.0D1
      ELSE IF (MOD(KA,4).EQ.2) THEN
        GA(I+1)=A
        GA(I+2)=-A
      ELSE IF (MOD(KA,4).EQ.3) THEN
        C=X(I)-2.0D0*X(I+1)
        GA(I)=2.0D0*C
        GA(I+1)=-4.0D0*C
      ELSE
        C=X(I-1)-X(I+2)
        D=2.0D0*B*C
        GA(I-1)=D
        GA(I+2)=-D
      END IF
      RETURN
   40 I=2*((KA+4)/5)
      IF (MOD(KA,5).EQ.1) THEN
        A=EXP(X(I-1))
        B=A-X(I)
        C=2.0D0*B
        GA(I-1)=C*A
        GA(I)=-C
      ELSE IF (MOD(KA,5).EQ.2) THEN
        A=X(I)-X(I+1)
        B=3.0D1*A**2
        GA(I)=B
        GA(I+1)=-B
      ELSE IF (MOD(KA,5).EQ.3) THEN
        C=X(I+1)-X(I+2)
        Q=SIN(C)/COS(C)
        R=COS(C)
        D=2.0D0*Q/R**2
        GA(I+1)=D
        GA(I+2)=-D
      ELSE IF (MOD(KA,5).EQ.4) THEN
        GA(I-1)=4.0D0*X(I-1)**3
      ELSE
        GA(I+2)=1.0D0
      END IF
      RETURN
   50 I=KA
      GA(I)=3.0D0-4.0D0*X(I)
      IF (I.GT.1) GA(I-1)=-1.0D0
      IF (I.LT.N) GA(I+1)=-1.0D0
      RETURN
   60 I=KA
      DO 70 J=MAX(1,I-5),MIN(N,I+1)
        GA(J)=1.0D0+2.0D0*X(J)
   70 CONTINUE
      GA(I)=GA(I)+2.0D0+1.5D1*X(I)**2
      RETURN
   80 I=(KA+1)/2
      IF (MOD(KA,2).EQ.1) THEN
        GA(I)=1.0D0
        GA(I+1)=1.0D1*X(I+1)-3.0D0*X(I+1)**2-2.0D0
      ELSE
        GA(I)=1.0D0
        GA(I+1)=2.0D0*X(I+1)+3.0D0*X(I+1)**2-1.4D1
      END IF
      RETURN
   90 I=MOD(KA,N/2)+1
      J=I+N/2
      M=5*N
      IF (KA.LE.M/2) THEN
        IA=1
      ELSE
        IA=2
      END IF
      IB=5-KA/(M/4)
      IC=MOD(KA,5)+1
      A=DBLE(IA)
      B=DBLE(IB)
      C=DBLE(IC)
      D=X(I)**IA-X(J)**IB
      IF (D.EQ.0.0D0) THEN
        GA(I)=0.0D0
        GA(J)=0.0D0
      ELSE
        E=C*D**(IC-1)
        IF (X(I).EQ.0.0D0.AND.IA.LE.1) THEN
          GA(I)=0.0D0
        ELSE
          GA(I)=E*A*X(I)**(IA-1)
        END IF
        IF (X(J).EQ.0.0D0.AND.IB.LE.1) THEN
          GA(J)=0.0D0
        ELSE
          GA(J)=-E*B*X(J)**(IB-1)
        END IF
      END IF
      RETURN
  100 I=2*((KA+5)/6)-1
      IF (MOD(KA,6).EQ.1) THEN
        GA(I)=1.0D0
        GA(I+1)=3.0D0*(X(I+2)-1.0D0)
        GA(I+2)=3.0D0*X(I+1)
        GA(I+3)=2.0D0*X(I+3)
      ELSE IF (MOD(KA,6).EQ.2) THEN
        GA(I)=2.0D0*(X(I)+X(I+1))
        GA(I+1)=2.0D0*(X(I)+X(I+1))
        GA(I+2)=2.0D0*(X(I+2)-1.0D0)
        GA(I+3)=-1.0D0
      ELSE IF (MOD(KA,6).EQ.3) THEN
        GA(I)=X(I+1)
        GA(I+1)=X(I)
        GA(I+2)=-X(I+3)
        GA(I+3)=-X(I+2)
      ELSE IF (MOD(KA,6).EQ.4) THEN
        GA(I)=2.0D0*X(I+2)
        GA(I+1)=X(I+3)
        GA(I+2)=2.0D0*X(I)
        GA(I+3)=X(I+1)
      ELSE IF (MOD(KA,6).EQ.5) THEN
        GA(I)=2.0D0*(X(I)+X(I+1)+X(I+2)+X(I+3))+2.0D0*(X(I)-1.0D0)
        GA(I+1)=2.0D0*(X(I)+X(I+1)+X(I+2)+X(I+3))
        GA(I+2)=2.0D0*(X(I)+X(I+1)+X(I+2)+X(I+3))
        GA(I+3)=2.0D0*(X(I)+X(I+1)+X(I+2)+X(I+3))
      ELSE
        GA(I)=X(I+1)*X(I+2)*X(I+3)
        GA(I+1)=X(I)*X(I+2)*X(I+3)
        GA(I+2)=X(I)*X(I+1)*X(I+3)
        GA(I+3)=X(I)*X(I+1)*X(I+2)+2.0D0*(X(I+3)-1.0D0)
      END IF
      RETURN
  110 IF (N.GE.2) THEN
        I=(KA+1)/2
        J=MOD(KA,2)
        IF (J.EQ.0) THEN
          GA(I)=-2.0D0*EXP(2.0D0*X(I))
          GA(I+1)=-2.0D0*EXP(2.0D0*X(I+1))
        ELSE IF (I.EQ.1) THEN
          GA(I)=-EXP(X(I))
          GA(I+1)=-EXP(X(I+1))
        ELSE IF (I.EQ.N) THEN
          GA(I-1)=-3.0D0*EXP(3.0D0*X(I-1))
          GA(I)=-3.0D0*EXP(3.0D0*X(I))
        ELSE
          GA(I-1)=-3.0D0*EXP(3.0D0*X(I-1))
          GA(I)=-3.0D0*EXP(3.0D0*X(I))-EXP(X(I))
          GA(I+1)=-EXP(X(I+1))
        END IF
      END IF
      RETURN
  120 I=(KA+1)/2
      IF (MOD(KA,2).EQ.1) THEN
        GA(I)=2.0D1*(1.0D0-X(I)**2)/(1.0D0+X(I)**2)**2
        GA(I+1)=-1.0D1
      ELSE
        GA(I)=1.0D0
      END IF
      RETURN
  130 I=3*((KA+5)/6)-2
      IF (MOD(KA,6).EQ.1) THEN
        GA(I)=2.0D1*X(I)
        GA(I+1)=-1.0D1
      ELSE IF (MOD(KA,6).EQ.2) THEN
        GA(I+2)=1.0D0
      ELSE IF (MOD(KA,6).EQ.3) THEN
        GA(I+3)=2.0D0*(X(I+3)-1.0D0)
      ELSE IF (MOD(KA,6).EQ.4) THEN
        GA(I+4)=3.0D0*(X(I+4)-1.0D0)**2
      ELSE IF (MOD(KA,6).EQ.5) THEN
        GA(I)=2.0D0*X(I)*X(I+3)
        GA(I+3)=X(I)**2+COS(X(I+3)-X(I+4))
        GA(I+4)=-COS(X(I+3)-X(I+4))
      ELSE
        GA(I+1)=1.0D0
        GA(I+2)=4.0D0*X(I+2)*(X(I+2)*X(I+3))**2
        GA(I+3)=2.0D0*X(I+2)**4*X(I+3)
      END IF
      RETURN
  140 I=3*((KA+6)/7)-2
      IF (MOD(KA,7).EQ.1) THEN
        GA(I)=2.0D1*X(I)
        GA(I+1)=-1.0D1
      ELSE IF (MOD(KA,7).EQ.2) THEN
        GA(I+1)=2.0D1*X(I+1)
        GA(I+2)=-1.0D1
      ELSE IF (MOD(KA,7).EQ.3) THEN
        GA(I+2)=2.0D0*(X(I+2)-X(I+3))
        GA(I+3)=-2.0D0*(X(I+2)-X(I+3))
      ELSE IF (MOD(KA,7).EQ.4) THEN
        GA(I+3)=2.0D0*(X(I+3)-X(I+4))
        GA(I+4)=-2.0D0*(X(I+3)-X(I+4))
      ELSE IF (MOD(KA,7).EQ.5) THEN
        GA(I)=1.0D0
        GA(I+1)=2.0D0*X(I+1)
        GA(I+2)=1.0D0
      ELSE IF (MOD(KA,7).EQ.6) THEN
        GA(I+1)=1.0D0
        GA(I+2)=-2.0D0*X(I+2)
        GA(I+3)=1.0D0
      ELSE
        GA(I)=X(I+4)
        GA(I+4)=X(I)
      END IF
      RETURN
  150 I=2*((KA+3)/4)-2
      L=MOD((KA-1),4)+1
      DO 160 J=1,4
        GA(I+J)=0.0D0
  160 CONTINUE
      DO 190 K=1,3
        A=DBLE(K*K)/DBLE(L)
        DO 170 J=1,4
          A=A*SIGN(1.0D0,X(I+J))*ABS(X(I+J))**(DBLE(J)/DBLE(K*L))
  170   CONTINUE
        DO 180 J=1,4
          GA(I+J)=GA(I+J)+(DBLE(J)/DBLE(K*L))*A/X(I+J)
  180   CONTINUE
  190 CONTINUE
      RETURN
  200 I=2*((KA+3)/4)-2
      L=MOD((KA-1),4)+1
      DO 210 J=1,4
        GA(I+J)=0.0D0
  210 CONTINUE
      DO 240 K=1,3
        A=0.0D0
        DO 220 J=1,4
          A=A+X(I+J)*(DBLE(J)/DBLE(K*L))
  220   CONTINUE
        A=EXP(A)*DBLE(K*K)/DBLE(L)
        DO 230 J=1,4
          GA(I+J)=GA(I+J)+A*(DBLE(J)/DBLE(K*L))
  230   CONTINUE
  240 CONTINUE
      RETURN
  250 I=2*((KA+3)/4)-2
      L=MOD((KA-1),4)+1
      DO 260 J=1,4
        GA(I+J)=DBLE((1-2*MOD(J,2))*L*J*J)*COS(X(I+J))-DBLE(L*L*J)*
     &   SIN(X(I+J))
  260 CONTINUE
      RETURN
  270 ALFA=0.5D0
      IF (KA.EQ.1) THEN
        GA(1)=-1.0D0-4.0D0*X(2)
        GA(2)=-4.0D0*X(1)
        GA(3)=ALFA-1.0D0
      ELSE IF (KA.EQ.2) THEN
        GA(1)=-4.0D0*X(2)
        GA(2)=-1.0D0-4.0D0*X(1)
        GA(4)=-2.0D0+ALFA
      ELSE IF (KA.EQ.N-1) THEN
        GA(N-3)=ALFA
        GA(N-1)=-1.0D0-4.0D0*X(N)
        GA(N)=-4.0D0*X(N-1)
      ELSE IF (KA.EQ.N) THEN
        GA(N-2)=ALFA
        GA(N-1)=-4.0D0*X(N)
        GA(N)=-1.0D0-4.0D0*X(N-1)
      ELSE IF (MOD(KA,2).EQ.1) THEN
        GA(KA-2)=ALFA
        GA(KA)=-1.0D0-4.0D0*X(KA+1)
        GA(KA+1)=-4.0D0*X(KA)
        GA(KA+2)=-1.0D0+ALFA
      ELSE
        GA(KA-2)=ALFA
        GA(KA-1)=-4.0D0*X(KA)
        GA(KA)=-1.0D0-4.0D0*X(KA-1)
        GA(KA+2)=-2.0D0+ALFA
      END IF
      RETURN
  280 IF (KA.LT.2) THEN
        GA(KA)=4.0D0
        GA(KA+1)=-8.0D0*X(KA+1)
      ELSE IF (KA.LT.N) THEN
        GA(KA-1)=-8.0D0*X(KA)
        GA(KA)=24.0D0*X(KA)**2-8.0D0*X(KA-1)+6.0D0
        GA(KA+1)=-8.0D0*X(KA+1)
      ELSE
        GA(KA-1)=-8.0D0*X(KA)
        GA(KA)=24.0D0*X(KA)**2-8.0D0*X(KA-1)+2.0D0
      END IF
      RETURN
  290 IF (KA.EQ.1) THEN
        GA(N-4)=3.0D0
        GA(N-3)=-1.0D0
        GA(N-2)=-1.0D0
        GA(N-1)=0.50D0
        GA(N)=-1.0D0
        GA(KA)=-4.0D0*X(KA)+3.0D0
        GA(KA+1)=-2.0D0
      ELSE IF (KA.LE.N-1) THEN
        GA(KA-1)=0.0D0
        GA(KA)=0.0D0
        GA(KA+1)=0.0D0
        GA(N-4)=3.0D0
        GA(N-3)=-1.0D0
        GA(N-2)=-1.0D0
        GA(N-1)=0.50D0
        GA(N)=-1.0D0
        GA(KA-1)=GA(KA-1)-1.0D0
        GA(KA)=GA(KA)-4.0D0*X(KA)+3.0D0
        GA(KA+1)=GA(KA+1)-2.0D0
      ELSE
        GA(N-4)=3.0D0
        GA(N-3)=-1.0D0
        GA(N-2)=-1.0D0
        GA(N-1)=0.50D0
        GA(N)=-4.0D0*X(N)+2.0D0
      END IF
      RETURN
  300 U=1.0D0/DBLE(N+1)
      V=DBLE(KA)*U
      GA(KA)=2.0D0+1.5D0*U**2*(X(KA)+V+1.0D0)**2
      IF (KA.GT.1) GA(KA-1)=-1.0D0
      IF (KA.LT.N) GA(KA+1)=-1.0D0
      RETURN
  310 I=3*((KA+6)/7)-2
      IF (MOD(KA,7).EQ.1) THEN
        GA(I)=2.0D1*X(I)
        GA(I+1)=-1.0D1
      ELSE IF (MOD(KA,7).EQ.2) THEN
        GA(I+1)=1.0D0
        GA(I+2)=1.0D0
      ELSE IF (MOD(KA,7).EQ.3) THEN
        GA(I+3)=1.0D0
      ELSE IF (MOD(KA,7).EQ.4) THEN
        GA(I+4)=1.0D0
      ELSE IF (MOD(KA,7).EQ.5) THEN
        GA(I)=1.0D0
        GA(I+1)=3.0D0
      ELSE IF (MOD(KA,7).EQ.6) THEN
        GA(I+2)=1.0D0
        GA(I+3)=1.0D0
        GA(I+4)=-2.0D0
      ELSE
        GA(I+1)=2.0D1*X(I+1)
        GA(I+4)=-1.0D1
      END IF
      RETURN
  320 I=KA/2
      IF (KA.EQ.1) THEN
        GA(KA)=1.0D0
      ELSE IF (MOD(KA,2).EQ.0) THEN
        GA(I)=2.0D1*X(I)
        GA(I+1)=-1.0D1
      ELSE
        A=2.0D0*EXP(-(X(I)-X(I+1))**2)
        B=EXP(-2.0D0*(X(I+1)-X(I+2))**2)
        GA(I)=-2.0D0*(X(I)-X(I+1))*A
        GA(I+1)=2.0D0*(X(I)-X(I+1))*A-4.0D0*(X(I+1)-X(I+2))*B
        GA(I+2)=4.0D0*(X(I+1)-X(I+2))*B
      END IF
      RETURN
  330 I=MOD(KA,N/2)+1
      J=I+N/2
      M=5*N
      IA=KA/(M/4)+1
      A=DBLE(IA)
      B=DBLE(KA/(M/5)+1)
      GA(I)=A*X(I)**(IA-1)*EXP(B*X(J))
      GA(J)=B*X(I)**IA*EXP(B*X(J))+1.0D0
      RETURN
  340 IA=MIN(MAX(MOD(KA,13)-2,1),7)
      IB=(KA+12)/13
      I=IA+IB-1
      IF (IA.EQ.7) THEN
        J=IB
      ELSE
        J=IA+IB
      END IF
      C=3.0D0*DBLE(IA)/1.0D1
      A=COS(C)
      B=EXP(SIN(C*X(J)))
      GA(I)=-COS(X(I))*(1.0D0+A)+5.0D0*B
      GA(J)=(1.0D0+A)+5.0D0*(X(I)-2.0D0)*C*COS(C*X(J))*B
      DO 350 L=0,6
        IF (IB+L.NE.I.AND.IB+L.NE.J) GA(IB+L)=0.5D0*COS(X(IB+L))
  350 CONTINUE
      RETURN
      END
! SUBROUTINE TIUB18             ALL SYSTEMS                 97/12/01
! PORTABILITY : ALL SYSTEMS
! 97/12/01 LU : ORIGINAL VERSION
!
! PURPOSE :
!  INITIATION OF VARIABLES AND DEFINITION OF STRUCTURE OF THE SPARSE
!  JACOBIAN MATRIX FOR THE SYSTEM OF NONLINEAR EQUATIONS.
!
! PARAMETERS :
!  IU  N  NUMBER OF VARIABLES.
!  IO  NA  NUMBER OF EQUATIONS.
!  IO  MA  NUMBER OF NONZERO ELEMENTS IN THE SPARSE JACOBIAN MATRIX.
!  RO  X(N)  VECTOR OF VARIABLES.
!  IO  IA(NA+1)  POINTERS OF FIRST IN THE ROW ELEMENTS IN THE
!         SPARSE JACOBIAN MATRIX.
!  IO  JA(MA)  COLUMN INDICES OF NONZERO ELEMENTS IN THE SPARSE
!         JACOBIAN MATRIX.
!  RO  FMIN  LOWER BOUND FOR THE OBJECTIVE FUNCTION VALUE.
!  RO  XMAX  MAXIMUM ALLOWED STEPSIZE.
!  II  NEXT  NUMBER OF THE TEST PROBLEM.
!  IO  IERR  ERROR INDICATOR.
!
      SUBROUTINE TIUB18 (N, NA, MA, X, IA, JA, FMIN, XMAX, NEXT, IERR)
      INTEGER N,NA,MA,IA(*),JA(*),NEXT,IERR
      DOUBLE PRECISION X(*),FMIN,XMAX,PAR
      INTEGER I,J,K,M
      COMMON /EMPR18/ PAR,M
      FMIN=0.0D0
      XMAX=1.0D4
      IERR=0
      GO TO (10,30,50,70,110,130,150,170,190,210,230,250,270,290,310,
     &370,410,580,430,450,560,780,800,470,660,720,630,690,600,500),NEXT
   10 IF (N.LT.4) GO TO 830
      N=N-MOD(N,2)
      NA=N
      MA=0
      IA(1)=1
      DO 20 I=1,N
        IF (MOD(I,8).EQ.1) X(I)=1.0D-1
        IF (MOD(I,8).EQ.2.OR.MOD(I,8).EQ.0) X(I)=2.0D-1
        IF (MOD(I,8).EQ.3.OR.MOD(I,8).EQ.7) X(I)=3.0D-1
        IF (MOD(I,8).EQ.4.OR.MOD(I,8).EQ.6) X(I)=4.0D-1
        IF (MOD(I,8).EQ.5) X(I)=5.0D-1
        IF (I.GT.2) THEN
          MA=MA+1
          JA(MA)=I-2
        END IF
        MA=MA+2
        IF (MOD(I,2).EQ.1) THEN
          JA(MA-1)=I
          JA(MA)=I+1
        ELSE
          JA(MA-1)=I-1
          JA(MA)=I
        END IF
        IF (I.LT.N-1) THEN
          MA=MA+1
          JA(MA)=I+2
        END IF
        IA(I+1)=MA+1
   20 CONTINUE
      RETURN
   30 IF (N.LT.5) GO TO 830
      N=N-MOD(N,2)
      NA=N
      MA=0
      IA(1)=1
      DO 40 I=1,N
        IF (MOD(I,8).EQ.1) X(I)=1.0D-1
        IF (MOD(I,8).EQ.2.OR.MOD(I,8).EQ.0) X(I)=2.0D-1
        IF (MOD(I,8).EQ.3.OR.MOD(I,8).EQ.7) X(I)=3.0D-1
        IF (MOD(I,8).EQ.4.OR.MOD(I,8).EQ.6) X(I)=4.0D-1
        IF (MOD(I,8).EQ.5) X(I)=5.0D-1
        MA=MA+1
        JA(MA)=1
        IF (I.GT.3) THEN
          MA=MA+1
          JA(MA)=I-2
        END IF
        IF (I.GT.2) THEN
          MA=MA+1
          JA(MA)=I-1
        END IF
        IF (I.GT.1) THEN
          MA=MA+1
          JA(MA)=I
        END IF
        IF (I.EQ.1) THEN
          MA=MA+1
          JA(MA)=I+1
        END IF
        IF (I.LT.N-1) THEN
          MA=MA+1
          JA(MA)=I+2
        END IF
        IA(I+1)=MA+1
   40 CONTINUE
      RETURN
   50 IF (N.LT.5) GO TO 830
      N=N-MOD(N,5)
      NA=N
      MA=0
      IA(1)=1
      DO 60 I=1,N
        X(I)=1.0D0/DBLE(N)
        J=(I-1)/5*5
        MA=MA+5
        JA(MA-4)=J+1
        JA(MA-3)=J+2
        JA(MA-2)=J+3
        JA(MA-1)=J+4
        JA(MA)=J+5
        IA(I+1)=MA+1
   60 CONTINUE
      RETURN
   70 IF (N.LT.3) GO TO 830
      DO 80 I=1,N
        X(I)=0.0D0
   80 CONTINUE
   90 NA=N
      MA=0
      IA(1)=1
      DO 100 I=1,N
        IF (I.GT.1) THEN
          MA=MA+1
          JA(MA)=I-1
        END IF
        MA=MA+1
        JA(MA)=I
        IF (I.LT.N) THEN
          MA=MA+1
          JA(MA)=I+1
        END IF
        IA(I+1)=MA+1
  100 CONTINUE
      RETURN
  110 IF (N.LT.3) GO TO 830
      IF (MOD(N,2).NE.1) N=N-1
      NA=N
      MA=0
      IA(1)=1
      DO 120 I=1,N
        X(I)=1.0D0
        IF (MOD(I,2).EQ.1) THEN
          IF (I.GT.1) THEN
            MA=MA+2
            JA(MA-1)=I-2
            JA(MA)=I-1
          END IF
          MA=MA+1
          JA(MA)=I
          IF (I.LT.N) THEN
            MA=MA+2
            JA(MA-1)=I+1
            JA(MA)=I+2
          END IF
        ELSE
          MA=MA+3
          JA(MA-2)=I-1
          JA(MA-1)=I
          JA(MA)=I+1
        END IF
        IA(I+1)=MA+1
  120 CONTINUE
      RETURN
  130 IF (N.LT.3) GO TO 830
      DO 140 I=1,N
        X(I)=-1.0D0
  140 CONTINUE
      GO TO 90
  150 IF (N.LT.3) GO TO 830
      DO 160 I=1,N
        X(I)=1.2D1
  160 CONTINUE
      XMAX=1.0D2
      GO TO 90
  170 IF (N.LT.5) GO TO 830
      NA=N
      MA=0
      IA(1)=1
      DO 180 I=1,N
        X(I)=-2.0D0
        IF (I.GT.2) THEN
          MA=MA+1
          JA(MA)=I-2
        END IF
        IF (I.GT.1) THEN
          MA=MA+1
          JA(MA)=I-1
        END IF
        MA=MA+1
        JA(MA)=I
        IF (I.LT.N) THEN
          MA=MA+1
          JA(MA)=I+1
        END IF
        IF (I.LT.N-1) THEN
          MA=MA+1
          JA(MA)=I+2
        END IF
        IA(I+1)=MA+1
  180 CONTINUE
      RETURN
  190 IF (N.LT.7) GO TO 830
      NA=N
      MA=0
      IA(1)=1
      DO 200 I=1,N
        X(I)=-3.0D0
        IF (I.GT.3) THEN
          MA=MA+1
          JA(MA)=I-3
        END IF
        IF (I.GT.2) THEN
          MA=MA+1
          JA(MA)=I-2
        END IF
        IF (I.GT.1) THEN
          MA=MA+1
          JA(MA)=I-1
        END IF
        MA=MA+1
        JA(MA)=I
        IF (I.LT.N) THEN
          MA=MA+1
          JA(MA)=I+1
        END IF
        IF (I.LT.N-1) THEN
          MA=MA+1
          JA(MA)=I+2
        END IF
        IF (I.LT.N-2) THEN
          MA=MA+1
          JA(MA)=I+3
        END IF
        IA(I+1)=MA+1
  200 CONTINUE
      XMAX=1.0D1
      RETURN
  210 IF (N.LT.7) GO TO 830
      NA=N
      MA=0
      IA(1)=1
      DO 220 I=1,N
        X(I)=-1.0D0
        IF (I.GT.1.AND.I.LT.N-3) THEN
          MA=MA+1
          JA(MA)=I-1
        END IF
        IF (I.LT.N-4) THEN
          MA=MA+1
          JA(MA)=I
        END IF
        IF (I.LT.N-5) THEN
          MA=MA+1
          JA(MA)=I+1
        END IF
        MA=MA+5
        JA(MA-4)=N-4
        JA(MA-3)=N-3
        JA(MA-2)=N-2
        JA(MA-1)=N-1
        JA(MA)=N
        IA(I+1)=MA+1
  220 CONTINUE
      RETURN
  230 IF (N.LT.2) GO TO 830
      N=N-MOD(N,2)
      NA=N
      MA=0
      IA(1)=1
      DO 240 I=1,N
        IF (MOD(I,2).EQ.1) THEN
          X(I)=9.0D1
          MA=MA+2
          JA(MA-1)=I
          JA(MA)=I+1
        ELSE
          X(I)=6.0D1
          MA=MA+2
          JA(MA-1)=I-1
          JA(MA)=I
        END IF
        IA(I+1)=MA+1
  240 CONTINUE
      RETURN
  250 IF (N.LT.4) GO TO 830
      N=N-MOD(N,4)
      NA=N
      MA=0
      IA(1)=1
      DO 260 I=1,N
        IF (MOD(I,4).EQ.1) THEN
          X(I)=3.0D0
          MA=MA+2
          JA(MA-1)=I
          JA(MA)=I+1
        ELSE IF (MOD(I,4).EQ.2) THEN
          X(I)=-1.0D0
          MA=MA+2
          JA(MA-1)=I+1
          JA(MA)=I+2
        ELSE IF (MOD(I,4).EQ.3) THEN
          X(I)=0.0D0
          MA=MA+2
          JA(MA-1)=I-1
          JA(MA)=I
        ELSE
          X(I)=1.0D0
          MA=MA+2
          JA(MA-1)=I-3
          JA(MA)=I
        END IF
        IA(I+1)=MA+1
  260 CONTINUE
      XMAX=1.0D2
      RETURN
  270 IF (N.LT.4) GO TO 830
      N=N-MOD(N,4)
      NA=N
      MA=0
      IA(1)=1
      DO 280 I=1,N
        IF (MOD(I,4).EQ.1) THEN
          X(I)=1.0D0
          MA=MA+2
          JA(MA-1)=I
          JA(MA)=I+1
        ELSE IF (MOD(I,4).EQ.2) THEN
          X(I)=2.0D0
          MA=MA+2
          JA(MA-1)=I
          JA(MA)=I+1
        ELSE IF (MOD(I,4).EQ.3) THEN
          X(I)=2.0D0
          MA=MA+2
          JA(MA-1)=I
          JA(MA)=I+1
        ELSE
          X(I)=2.0D0
          MA=MA+1
          JA(MA)=I
        END IF
        IA(I+1)=MA+1
  280 CONTINUE
      XMAX=1.0D1
      RETURN
  290 IF (N.LT.3) GO TO 830
      DO 300 I=1,N
        X(I)=-1.0D0
  300 CONTINUE
      GO TO 90
  310 IF (N.LT.7) GO TO 830
      NA=N
      MA=0
      IA(1)=1
      DO 330 I=1,5
        X(I)=-1.0D0
        DO 320 K=1,I+1
          MA=MA+1
          JA(MA)=K
  320   CONTINUE
        IA(I+1)=MA+1
  330 CONTINUE
      DO 350 I=6,N-1
        X(I)=-1.0D0
        DO 340 K=I-5,I+1
          MA=MA+1
          JA(MA)=K
  340   CONTINUE
        IA(I+1)=MA+1
  350 CONTINUE
      X(N)=-1.0D0
      DO 360 K=N-5,N
        MA=MA+1
        JA(MA)=K
  360 CONTINUE
      IA(N+1)=MA+1
      RETURN
  370 IF (N.LT.2) GO TO 830
      N=N-MOD(N,2)
      NA=N
      DO 380 I=1,N
        IF (MOD(I,2).EQ.1) THEN
          X(I)=0.0D0
        ELSE
          X(I)=1.0D0
        END IF
  380 CONTINUE
      MA=1
      DO 400 I=1,N-1,2
        IA(I)=2*I-1
        IA(I+1)=2*I+1
        DO 390 J=1,2
          JA(MA)=I
          MA=MA+1
          JA(MA)=I+1
          MA=MA+1
  390   CONTINUE
  400 CONTINUE
      IA(N+1)=MA
      MA=MA-1
      RETURN
  410 IF (N.LT.4) GO TO 830
      N=N-MOD(N,4)
      NA=N
      IA(1)=1
      J=0
      DO 420 I=2,N,2
        X(I-1)=-3.0D0
        X(I)=-1.0D0
        IA(I)=IA(I-1)+2
        IA(I+1)=IA(I)+3
        MA=IA(I-1)+4
        JA(MA-4)=I-1
        JA(MA-3)=I
        IF (J.EQ.0) THEN
          JA(MA-2)=I-1
          JA(MA-1)=I
          JA(MA)=I+2
          J=1
        ELSE
          JA(MA-2)=I-2
          JA(MA-1)=I-1
          JA(MA)=I
          J=0
        END IF
  420 CONTINUE
      RETURN
  430 IF (N.LT.3) GO TO 830
      DO 440 I=1,N
        X(I)=DBLE(I)/DBLE(N+1)
        X(I)=X(I)*(X(I)-1.0D0)
  440 CONTINUE
      GO TO 90
  450 IF (N.LT.3) GO TO 830
      DO 460 I=1,N
        X(I)=1.0D1
  460 CONTINUE
      GO TO 90
  470 IF (N.LT.16) GO TO 830
      M=INT(SQRT(DBLE(N)))
      PAR=6.7D0/DBLE(M+1)**2
      N=M*M
      K=0
      DO 490 J=1,M
        DO 480 I=1,M
          K=K+1
          X(K)=0.0D0
  480   CONTINUE
  490 CONTINUE
      GO TO 750
  500 IF (N.LT.16) GO TO 830
      M=INT(SQRT(DBLE(N)))
      N=M*M
      PAR=500.0D0
      K=0
      DO 520 J=1,M
        DO 510 I=1,M
          K=K+1
          X(K)=0.0D0
  510   CONTINUE
  520 CONTINUE
  530 NA=N
      MA=0
      IA(1)=1
      K=0
      DO 550 J=1,M
        DO 540 I=1,M
          K=K+1
          IF (J.GT.2) THEN
            MA=MA+1
            JA(MA)=K-M-M
          END IF
          IF (J.GT.1) THEN
            IF (I.GT.1) THEN
              MA=MA+1
              JA(MA)=K-M-1
            END IF
            MA=MA+1
            JA(MA)=K-M
            IF (I.LT.M) THEN
              MA=MA+1
              JA(MA)=K-M+1
            END IF
          END IF
          IF (I.GT.1) THEN
            IF (I.GT.2) THEN
              MA=MA+1
              JA(MA)=K-2
            END IF
            MA=MA+1
            JA(MA)=K-1
          END IF
          MA=MA+1
          JA(MA)=K
          IF (I.LT.M) THEN
            MA=MA+1
            JA(MA)=K+1
            IF (I.LT.M-1) THEN
              MA=MA+1
              JA(MA)=K+2
            END IF
          END IF
          IF (J.LT.M) THEN
            IF (I.GT.1) THEN
              MA=MA+1
              JA(MA)=K+M-1
            END IF
            MA=MA+1
            JA(MA)=K+M
            IF (I.LT.M) THEN
              MA=MA+1
              JA(MA)=K+M+1
            END IF
          END IF
          IF (J.LT.M-1) THEN
            MA=MA+1
            JA(MA)=K+M+M
          END IF
          IA(K+1)=MA+1
  540   CONTINUE
  550 CONTINUE
      RETURN
  560 IF (N.LT.3) GO TO 830
      DO 570 I=1,N
        X(I)=1.0D0
  570 CONTINUE
      PAR=1.0D1
      GO TO 90
  580 IF (N.LT.3) GO TO 830
      DO 590 I=1,N
        X(I)=1.5D0
  590 CONTINUE
      XMAX=1.0D0
      GO TO 90
  600 IF (N.LT.16) GO TO 830
      M=INT(SQRT(DBLE(N)))
      N=M*M
      PAR=500.0D0/DBLE(M+2)**4
      K=0
      DO 620 J=1,M
        DO 610 I=1,M
          K=K+1
          X(K)=0.0D0
  610   CONTINUE
  620 CONTINUE
      GO TO 530
  630 IF (N.LT.16) GO TO 830
      M=INT(SQRT(DBLE(N)))
      PAR=5.0D1/DBLE(M+1)
      N=M*M
      K=0
      DO 650 J=1,M
        DO 640 I=1,M
          K=K+1
          X(K)=1.0D0-DBLE(I)*DBLE(J)/DBLE(M+1)**2
  640   CONTINUE
  650 CONTINUE
      GO TO 750
  660 IF (N.LT.16) GO TO 830
      M=INT(SQRT(DBLE(N)))
      PAR=1.0D0/DBLE(M+1)**2
      N=M*M
      K=0
      DO 680 J=1,M
        DO 670 I=1,M
          K=K+1
          X(K)=-1.0D0
  670   CONTINUE
  680 CONTINUE
      GO TO 750
  690 IF (N.LT.16) GO TO 830
      M=INT(SQRT(DBLE(N)))
      PAR=1.0D0/DBLE(M+1)
      N=M*M
      K=0
      DO 710 J=1,M
        DO 700 I=1,M
          K=K+1
          X(K)=0.0D0
  700   CONTINUE
  710 CONTINUE
      GO TO 750
  720 IF (N.LT.16) GO TO 830
      M=INT(SQRT(DBLE(N)))
      PAR=1.0D0/DBLE(M+1)**2
      N=M*M
      K=0
      DO 740 J=1,M
        DO 730 I=1,M
          K=K+1
          X(K)=0.0D0
  730   CONTINUE
  740 CONTINUE
  750 NA=N
      MA=0
      IA(1)=1
      K=0
      DO 770 J=1,M
        DO 760 I=1,M
          K=K+1
          IF (J.GT.1) THEN
            MA=MA+1
            JA(MA)=K-M
          END IF
          IF (I.GT.1) THEN
            MA=MA+1
            JA(MA)=K-1
          END IF
          MA=MA+1
          JA(MA)=K
          IF (I.LT.M) THEN
            MA=MA+1
            JA(MA)=K+1
          END IF
          IF (J.LT.M) THEN
            MA=MA+1
            JA(MA)=K+M
          END IF
          IA(K+1)=MA+1
  760   CONTINUE
  770 CONTINUE
      RETURN
  780 IF (N.LT.5) GO TO 830
      PAR=5.0D2/DBLE(N+2)
      NA=N
      MA=0
      IA(1)=1
      DO 790 I=1,N
        X(I)=((DBLE(I)+0.5D0)/DBLE(N+2)-0.5D0)**2
        IF (I.GT.2) THEN
          MA=MA+1
          JA(MA)=I-2
        END IF
        IF (I.GT.1) THEN
          MA=MA+1
          JA(MA)=I-1
        END IF
        MA=MA+1
        JA(MA)=I
        IF (I.LT.N) THEN
          MA=MA+1
          JA(MA)=I+1
        END IF
        IF (I.LT.N-1) THEN
          MA=MA+1
          JA(MA)=I+2
        END IF
        IA(I+1)=MA+1
  790 CONTINUE
      RETURN
  800 IF (N.LT.10) GO TO 830
      N=N-MOD(N,2)
      M=N/2
      PAR=5.0D2
      NA=N
      MA=0
      IA(1)=1
      DO 810 I=1,M
        K=I+M
        X(I)=(DBLE(I)/DBLE(M+1)-0.5D0)**2
        IF (I.GT.2) THEN
          MA=MA+1
          JA(MA)=I-2
        END IF
        IF (I.GT.1) THEN
          MA=MA+1
          JA(MA)=I-1
        END IF
        MA=MA+1
        JA(MA)=I
        IF (I.LT.M) THEN
          MA=MA+1
          JA(MA)=I+1
        END IF
        IF (I.LT.M-1) THEN
          MA=MA+1
          JA(MA)=I+2
        END IF
        IF (I.GT.1) THEN
          MA=MA+1
          JA(MA)=K-1
        END IF
        MA=MA+1
        JA(MA)=K
        IF (I.LT.M) THEN
          MA=MA+1
          JA(MA)=K+1
        END IF
        IA(I+1)=MA+1
  810 CONTINUE
      DO 820 I=M+1,N
        K=I-M
        X(I)=DBLE(K)/DBLE(M+1)-0.5D0
        IF (K.GT.1) THEN
          MA=MA+1
          JA(MA)=K-1
        END IF
        MA=MA+1
        JA(MA)=K
        IF (K.LT.M) THEN
          MA=MA+1
          JA(MA)=K+1
        END IF
        IF (K.GT.1) THEN
          MA=MA+1
          JA(MA)=I-1
        END IF
        MA=MA+1
        JA(MA)=I
        IF (K.LT.M) THEN
          MA=MA+1
          JA(MA)=I+1
        END IF
        IA(I+1)=MA+1
  820 CONTINUE
      RETURN
  830 IERR=1
      RETURN
      END
! SUBROUTINE TAFU18             ALL SYSTEMS                 97/12/01
! PORTABILITY : ALL SYSTEMS
! 97/12/01 LU : ORIGINAL VERSION
!
! PURPOSE :
!  VALUES OF EQUATION FUNCTIONS (LEFT HAND SIDES) IN THE SYSTEM OF
!  NONLINEAR EQUATIONS.
!
! PARAMETERS :
!  II  N  NUMBER OF VARIABLES.
!  II  KA  INDEX OF THE GIVEN EQUATION.
!  RI  X(N)  VECTOR OF VARIABLES.
!  RO  FA  VALUE OF THE KA-TH EQUATION FUNCTION AT THE POINT X.
!  II  NEXT  NUMBER OF THE SELECTED TEST PROBLEM.
!
      SUBROUTINE TAFU18 (N, KA, X, FA, NEXT)
      INTEGER N,KA,NEXT
      DOUBLE PRECISION X(*),FA
      INTEGER I,J,M
      DOUBLE PRECISION A1,A2,A3,A4,H,PAR,PI
      DATA PI/3.14159265358979323D0/
      COMMON /EMPR18/ PAR,M
      GO TO (10,20,30,50,60,70,80,90,100,110,120,130,140,150,160,180,
     &190,200,210,220,230,240,250,260,270,280,290,300,310,320),NEXT
   10 A2=0.5D0
      IF (KA.EQ.1) THEN
        FA=A2-(1.0D0-A2)*X(3)-X(1)*(1.0D0+4.0D0*X(2))
      ELSE IF (KA.EQ.2) THEN
        FA=-(2.0D0-A2)*X(4)-X(2)*(1.0D0+4.0D0*X(1))
      ELSE IF (KA.EQ.N-1) THEN
        FA=A2*X(N-3)-X(N-1)*(1.0D0+4.0D0*X(N))
      ELSE IF (KA.EQ.N) THEN
        FA=A2*X(N-2)-(2.0D0-A2)-X(N)*(1.0D0+4.0D0*X(N-1))
      ELSE IF (MOD(KA,2).EQ.1) THEN
        FA=A2*X(KA-2)-(1.0D0-A2)*X(KA+2)-X(KA)*(1.0D0+4.0D0*X(KA+1))
      ELSE
        FA=A2*X(KA-2)-(2.0D0-A2)*X(KA+2)-X(KA)*(1.0D0+4.0D0*X(KA-1))
      END IF
      RETURN
   20 A1=0.414214D0
      IF (KA.EQ.1) THEN
        FA=X(1)-(1.0D0-X(1))*X(3)-A1*(1.0D0+4.0D0*X(2))
      ELSE IF (KA.EQ.2) THEN
        FA=-(1.0D0-X(1))*X(4)-A1*(1.0D0+4.0D0*X(2))
      ELSE IF (KA.EQ.3) THEN
        FA=A1*X(1)-(1.0D0-X(1))*X(5)-X(3)*(1.0D0+4.0D0*X(2))
      ELSE IF (KA.LE.N-2) THEN
        FA=X(1)*X(KA-2)-(1.0D0-X(1))*X(KA+2)-X(KA)*(1.0D0+4.0D0*X(KA-1))
      ELSE IF (KA.EQ.N-1) THEN
        FA=X(1)*X(N-3)-X(N-1)*(1.0D0+4.0D0*X(N-2))
      ELSE
        FA=X(1)*X(N-2)-(1.0D0-X(1))-X(N)*(1.0D0+4.0D0*X(N-1))
      END IF
      RETURN
   30 J=(KA-1)/5
      FA=5.0D0-DBLE(J+1)*(1.0D0-COS(X(KA)))-SIN(X(KA))
      J=J*5
      DO 40 I=J+1,J+5
        FA=FA-COS(X(I))
   40 CONTINUE
      RETURN
   50 IF (KA.LT.2) THEN
        FA=3.0D0*X(KA)**3+2.0D0*X(KA+1)-5.0D0+SIN(X(KA)-X(KA+1))*
     &   SIN(X(KA)+X(KA+1))
      ELSE IF (KA.LT.N) THEN
        FA=3.0D0*X(KA)**3+2.0D0*X(KA+1)-5.0D0+SIN(X(KA)-X(KA+1))*
     &   SIN(X(KA)+X(KA+1))+4.0D0*X(KA)-X(KA-1)*EXP(X(KA-1)-X(KA))-
     &   3.0D0
      ELSE
        FA=4.0D0*X(KA)-X(KA-1)*EXP(X(KA-1)-X(KA))-3.0D0
      END IF
      RETURN
   60 IF (MOD(KA,2).EQ.1) THEN
        FA=0.0D0
        IF (KA.NE.1) FA=FA-6.0D0*(X(KA-2)-X(KA))**3+1.0D1-4.0D0*X(KA-1)-
     &   2.0D0*SIN(X(KA-2)-X(KA-1)-X(KA))*SIN(X(KA-2)+X(KA-1)-X(KA))
        IF (KA.NE.N) FA=FA+3.0D0*(X(KA)-X(KA+2))**3-5.0D0+2.0D0*X(KA+1)+
     &   SIN(X(KA)-X(KA+1)-X(KA+2))*SIN(X(KA)+X(KA+1)-X(KA+2))
      ELSE
        FA=4.0D0*X(KA)-(X(KA-1)-X(KA+1))*EXP(X(KA-1)-X(KA)-X(KA+1))-
     &   3.0D0
      END IF
      RETURN
   70 H=2.0D0
      IF (KA.EQ.1) THEN
        FA=((3.0D0-H*X(1))*X(1)-2.0D0*X(2)+1.0D0)**2
      ELSE IF (KA.LE.N-1) THEN
        FA=((3.0D0-H*X(KA))*X(KA)-X(KA-1)-2.0D0*X(KA+1)+1.0D0)**2
      ELSE
        FA=((3.0D0-H*X(N))*X(N)-X(N-1)+1.0D0)**2
      END IF
      RETURN
   80 IF (KA.LT.2) THEN
        FA=4.0D0*(X(KA)-X(KA+1)**2)
      ELSE IF (KA.LT.N) THEN
        FA=8.0D0*X(KA)*(X(KA)**2-X(KA-1))-2.0D0*(1.0D0-X(KA))+4.0D0*
     &   (X(KA)-X(KA+1)**2)
      ELSE
        FA=8.0D0*X(KA)*(X(KA)**2-X(KA-1))-2.0D0*(1.0D0-X(KA))
      END IF
      RETURN
   90 IF (KA.LT.2) THEN
        FA=4.0D0*(X(KA)-X(KA+1)**2)+X(KA+1)-X(KA+2)**2
      ELSE IF (KA.LT.3) THEN
        FA=8.0D0*X(KA)*(X(KA)**2-X(KA-1))-2.0D0*(1.0D0-X(KA))+4.0D0*
     &   (X(KA)-X(KA+1)**2)+X(KA+1)-X(KA+2)**2
      ELSE IF (KA.LT.N-1) THEN
        FA=8.0D0*X(KA)*(X(KA)**2-X(KA-1))-2.0D0*(1.0D0-X(KA))+4.0D0*
     &   (X(KA)-X(KA+1)**2)+X(KA-1)**2-X(KA-2)+X(KA+1)-X(KA+2)**2
      ELSE IF (KA.LT.N) THEN
        FA=8.0D0*X(KA)*(X(KA)**2-X(KA-1))-2.0D0*(1.0D0-X(KA))+4.0D0*
     &   (X(KA)-X(KA+1)**2)+X(KA-1)**2-X(KA-2)
      ELSE
        FA=8.0D0*X(KA)*(X(KA)**2-X(KA-1))-2.0D0*(1.0D0-X(KA))+X(KA-1)**
     &   2-X(KA-2)
      END IF
      RETURN
  100 IF (KA.LT.2) THEN
        FA=4.0D0*(X(KA)-X(KA+1)**2)+X(KA+1)-X(KA+2)**2+X(KA+2)-X(KA+3)**
     &   2
      ELSE IF (KA.LT.3) THEN
        FA=8.0D0*X(KA)*(X(KA)**2-X(KA-1))-2.0D0*(1.0D0-X(KA))+4.0D0*
     &   (X(KA)-X(KA+1)**2)+X(KA-1)**2+X(KA+1)-X(KA+2)**2+X(KA+2)-X(KA+
     &   3)**2
      ELSE IF (KA.LT.4) THEN
        FA=8.0D0*X(KA)*(X(KA)**2-X(KA-1))-2.0D0*(1.0D0-X(KA))+4.0D0*
     &   (X(KA)-X(KA+1)**2)+X(KA-1)**2-X(KA-2)+X(KA+1)-X(KA+2)**2+X(KA-
     &   2)**2+X(KA+2)-X(KA+3)**2
      ELSE IF (KA.LT.N-2) THEN
        FA=8.0D0*X(KA)*(X(KA)**2-X(KA-1))-2.0D0*(1.0D0-X(KA))+4.0D0*
     &   (X(KA)-X(KA+1)**2)+X(KA-1)**2-X(KA-2)+X(KA+1)-X(KA+2)**2+X(KA-
     &   2)**2-X(KA-3)+X(KA+2)-X(KA+3)**2
      ELSE IF (KA.LT.N-1) THEN
        FA=8.0D0*X(KA)*(X(KA)**2-X(KA-1))-2.0D0*(1.0D0-X(KA))+4.0D0*
     &   (X(KA)-X(KA+1)**2)+X(KA-1)**2-X(KA-2)+X(KA+1)-X(KA+2)**2+X(KA-
     &   2)**2-X(KA-3)+X(KA+2)
      ELSE IF (KA.LT.N) THEN
        FA=8.0D0*X(KA)*(X(KA)**2-X(KA-1))-2.0D0*(1.0D0-X(KA))+4.0D0*
     &   (X(KA)-X(KA+1)**2)+X(KA-1)**2-X(KA-2)+X(KA+1)+X(KA-2)**2-X(KA-
     &   3)
      ELSE
        FA=8.0D0*X(KA)*(X(KA)**2-X(KA-1))-2.0D0*(1.0D0-X(KA))+X(KA-1)**
     &   2-X(KA-2)+X(KA-2)**2-X(KA-3)
      END IF
      RETURN
  110 IF (KA.EQ.1) THEN
        FA=-2.0D0*X(KA)**2+3.0D0*X(KA)-2.0D0*X(KA+1)+3.0D0*X(N-4)-X(N-3)
     &   -X(N-2)+0.5D0*X(N-1)-X(N)+1.0D0
      ELSE IF (KA.LE.N-1) THEN
        FA=-2.0D0*X(KA)**2+3.0D0*X(KA)-X(KA-1)-2.0D0*X(KA+1)+3.0D0*X(N-
     &   4)-X(N-3)-X(N-2)+0.5D0*X(N-1)-X(N)+1.0D0
      ELSE
        FA=-2.0D0*X(N)**2+3.0D0*X(N)-X(N-1)+3.0D0*X(N-4)-X(N-3)-X(N-2)+
     &   0.5D0*X(N-1)-X(N)+1.0D0
      END IF
      RETURN
  120 IF (MOD(KA,2).EQ.1) THEN
        FA=X(KA)+((5.0D0-X(KA+1))*X(KA+1)-2.0D0)*X(KA+1)-1.3D1
      ELSE
        FA=X(KA-1)+((X(KA)+1.0D0)*X(KA)-1.4D1)*X(KA)-2.9D1
      END IF
      RETURN
  130 IF (MOD(KA,4).EQ.1) THEN
        FA=X(KA)+1.0D1*X(KA+1)
      ELSE IF (MOD(KA,4).EQ.2) THEN
        FA=2.23606797749979D0*(X(KA+1)-X(KA+2))
      ELSE IF (MOD(KA,4).EQ.3) THEN
        FA=(X(KA-1)-2.0D0*X(KA))**2
      ELSE
        FA=3.16227766016838D0*(X(KA-3)-X(KA))**2
      END IF
      RETURN
  140 IF (MOD(KA,4).EQ.1) THEN
        FA=(EXP(X(KA))-X(KA+1))**2
      ELSE IF (MOD(KA,4).EQ.2) THEN
        FA=1.0D1*(X(KA)-X(KA+1))**3
      ELSE IF (MOD(KA,4).EQ.3) THEN
        FA=X(KA)-X(KA+1)
        FA=(SIN(FA)/COS(FA))**2
      ELSE
        FA=X(KA)-1.0D0
      END IF
      RETURN
  150 IF (KA.LT.2) THEN
        FA=X(KA)*(0.5D0*X(KA)-3.0D0)-1.0D0+2.0D0*X(KA+1)
      ELSE IF (KA.LT.N) THEN
        FA=X(KA-1)+X(KA)*(0.5D0*X(KA)-3.0D0)-1.0D0+2.0D0*X(KA+1)
      ELSE
        FA=X(KA-1)+X(KA)*(0.5D0*X(KA)-3.0D0)-1.0D0
      END IF
      RETURN
  160 FA=(2.0D0+5.0D0*X(KA)**2)*X(KA)+1.0D0
      DO 170 I=MAX(1,KA-5),MIN(N,KA+1)
        FA=FA+X(I)*(1.0D0+X(I))
  170 CONTINUE
      RETURN
  180 IF (MOD(KA,2).EQ.1) THEN
        FA=1.0D4*X(KA)*X(KA+1)-1.0D0
      ELSE
        FA=EXP(-X(KA-1))+EXP(-X(KA))-1.0001D0
      END IF
      RETURN
  190 IF (MOD(KA,4).EQ.1) THEN
        FA=-2.0D2*X(KA)*(X(KA+1)-X(KA)**2)-(1.0D0-X(KA))
      ELSE IF (MOD(KA,4).EQ.2) THEN
        FA=2.0D2*(X(KA)-X(KA-1)**2)+2.02D1*(X(KA)-1.0D0)+1.98D1*(X(KA+2)
     &   -1.0D0)
      ELSE IF (MOD(KA,4).EQ.3) THEN
        FA=-1.8D2*X(KA)*(X(KA+1)-X(KA)**2)-(1.0D0-X(KA))
      ELSE
        FA=1.8D2*(X(KA)-X(KA-1)**2)+2.02D1*(X(KA)-1.0D0)+1.98D1*(X(KA-2)
     &   -1.0D0)
      END IF
      RETURN
  200 IF (KA.LT.2) THEN
        FA=X(KA)-EXP(COS(DBLE(KA)*(X(KA)+X(KA+1))))
      ELSE IF (KA.LT.N) THEN
        FA=X(KA)-EXP(COS(DBLE(KA)*(X(KA-1)+X(KA)+X(KA+1))))
      ELSE
        FA=X(KA)-EXP(COS(DBLE(KA)*(X(KA-1)+X(KA))))
      END IF
      RETURN
  210 A3=1.0D0/DBLE(N+1)
      A4=DBLE(KA)*A3
      FA=2.0D0*X(KA)+0.5D0*A3*A3*(X(KA)+A4+1.0D0)**3
      IF (KA.GT.1) FA=FA-X(KA-1)
      IF (KA.LT.N) FA=FA-X(KA+1)
      RETURN
  220 IF (KA.EQ.1) THEN
        FA=3.0D0*X(KA)*(X(KA+1)-2.0D0*X(KA))+0.25D0*X(KA+1)**2
      ELSE IF (KA.EQ.N) THEN
        FA=3.0D0*X(KA)*(2.0D1-2.0D0*X(KA)+X(KA-1))+0.25D0*(2.0D1-X(KA-1)
     &   )**2
      ELSE
        FA=3.0D0*X(KA)*(X(KA+1)-2.0D0*X(KA)+X(KA-1))+0.25D0*(X(KA+1)-
     &   X(KA-1))**2
      END IF
      RETURN
  230 H=1.0D0/DBLE(N+1)
      IF (KA.LT.2) THEN
        FA=2.0D0*X(KA)+PAR*H**2*SINH(PAR*X(KA))-X(KA+1)
      ELSE IF (KA.LT.N) THEN
        FA=2.0D0*X(KA)+PAR*H**2*SINH(PAR*X(KA))-X(KA-1)-X(KA+1)
      ELSE
        FA=2.0D0*X(KA)+PAR*H**2*SINH(PAR*X(KA))-X(KA-1)-1.0D0
      END IF
      RETURN
  240 FA=6.0D0*X(KA)
      A1=0.0D0
      A2=0.0D0
      A3=0.0D0
      IF (KA.GT.1) THEN
        FA=FA-4.0D0*X(KA-1)
        A1=A1-X(KA-1)
        A2=A2+X(KA-1)
        A3=A3+2.0D0*X(KA-1)
      END IF
      IF (KA.GT.2) THEN
        FA=FA+X(KA-2)
        A3=A3-X(KA-2)
      END IF
      IF (KA.LT.N-1) THEN
        FA=FA+X(KA+2)
        A3=A3+X(KA+2)
      END IF
      IF (KA.LT.N) THEN
        FA=FA-4.0D0*X(KA+1)
        A1=A1+X(KA+1)
        A2=A2+X(KA+1)
        A3=A3-2.0D0*X(KA+1)
      END IF
      IF (KA.GE.N-1) THEN
        FA=FA+1.0D0
        A3=A3+1.0D0
      END IF
      IF (KA.GE.N) THEN
        FA=FA-4.0D0
        A1=A1+1.0D0
        A2=A2+1.0D0
        A3=A3-2.0D0
      END IF
      FA=FA-0.5D0*PAR*(A1*A2-X(KA)*A3)
      RETURN
  250 H=1.0D0/(M+1)
      IF (KA.LE.M) THEN
        J=KA+M
        FA=6.0D0*X(KA)
        A1=0.0D0
        A2=0.0D0
        IF (KA.EQ.1) THEN
          A1=A1+1.0D0
        END IF
        IF (KA.GT.1) THEN
          FA=FA-4.0D0*X(KA-1)
          A1=A1-X(J-1)
          A2=A2+2.0D0*X(KA-1)
        END IF
        IF (KA.GT.2) THEN
          FA=FA+X(KA-2)
          A2=A2-X(KA-2)
        END IF
        IF (KA.LT.M-1) THEN
          FA=FA+X(KA+2)
          A2=A2+X(KA+2)
        END IF
        IF (KA.LT.M) THEN
          FA=FA-4.0D0*X(KA+1)
          A1=A1+X(J+1)
          A2=A2-2.0D0*X(KA+1)
        END IF
        IF (KA.EQ.M) THEN
          A1=A1+1.0D0
        END IF
        FA=FA+0.5D0*PAR*H*(X(KA)*A2+X(J)*A1*H**2)
      ELSE
        J=KA-M
        FA=-2.0D0*X(KA)
        A1=0.0D0
        A2=0.0D0
        IF (J.EQ.1) THEN
          A2=A2+1.0D0
        END IF
        IF (J.GT.1) THEN
          FA=FA+X(KA-1)
          A1=A1-X(J-1)
          A2=A2-X(KA-1)
        END IF
        IF (J.LT.M) THEN
          FA=FA+X(KA+1)
          A1=A1+X(J+1)
          A2=A2+X(KA+1)
        END IF
        IF (J.EQ.M) THEN
          A2=A2+1.0D0
        END IF
        FA=FA+0.5D0*PAR*H*(X(KA)*A1+X(J)*A2)
      END IF
      RETURN
  260 FA=4.0D0*X(KA)-PAR*EXP(X(KA))
      J=(KA-1)/M+1
      I=KA-(J-1)*M
      IF (I.GT.1) FA=FA-X(KA-1)
      IF (I.LT.M) FA=FA-X(KA+1)
      IF (J.GT.1) FA=FA-X(KA-M)
      IF (J.LT.M) FA=FA-X(KA+M)
      RETURN
  270 FA=4.0D0*X(KA)
      J=(KA-1)/M+1
      I=KA-(J-1)*M
      FA=FA+PAR*X(KA)**3/(1.0D0+PAR*DBLE(I)**2+PAR*DBLE(J)**2)
      IF (I.EQ.1) FA=FA-1.0D0
      IF (I.GT.1) FA=FA-X(KA-1)
      IF (I.LT.M) FA=FA-X(KA+1)
      IF (I.EQ.M) FA=FA-2.0D0+EXP(DBLE(J)/DBLE(M+1))
      IF (J.EQ.1) FA=FA-1.0D0
      IF (J.GT.1) FA=FA-X(KA-M)
      IF (J.LT.M) FA=FA-X(KA+M)
      IF (J.EQ.M) FA=FA-2.0D0+EXP(DBLE(I)/DBLE(M+1))
      RETURN
  280 FA=4.0D0*X(KA)-PAR*SIN(2.0D0*PI*X(KA))
      J=(KA-1)/M+1
      I=KA-(J-1)*M
      A1=DBLE(I)/DBLE(M+1)
      A2=DBLE(J)/DBLE(M+1)
      FA=FA-1.0D4*((A1-0.25D0)**2+(A2-0.75D0)**2)*PAR
      IF (I.EQ.1) FA=FA-X(KA+1)-PAR*SIN(PI*X(KA+1)*DBLE(M+1))
      IF (I.GT.1.AND.I.LT.M) FA=FA-X(KA+1)-X(KA-1)-PAR*SIN(PI*(X(KA+1)-
     &X(KA-1))*DBLE(M+1))
      IF (I.EQ.M) FA=FA-X(KA-1)+PAR*SIN(PI*X(KA-1)*DBLE(M+1))
      IF (J.EQ.1) FA=FA-X(KA+M)-PAR*SIN(PI*X(KA+M)*DBLE(M+1))
      IF (J.GT.1.AND.J.LT.M) FA=FA-X(KA+M)-X(KA-M)-PAR*SIN(PI*(X(KA+M)-
     &X(KA-M))*DBLE(M+1))
      IF (J.EQ.M) FA=FA-X(KA-M)+PAR*SIN(PI*X(KA-M)*DBLE(M+1))
      RETURN
  290 FA=8.0D0*X(KA)**2
      J=(KA-1)/M+1
      I=KA-(J-1)*M
      IF (I.EQ.1) FA=FA-2.0D0*X(KA)*(X(KA+1)+1.0D0)-0.5D0*(X(KA+1)-
     &1.0D0)**2-1.5D0*X(KA)**2*(X(KA+1)-1.0D0)*PAR
      IF (I.GT.1.AND.I.LT.M) FA=FA-2.0D0*X(KA)*(X(KA+1)+X(KA-1))-0.5D0*
     &(X(KA+1)-X(KA-1))**2-1.5D0*X(KA)**2*(X(KA+1)-X(KA-1))*PAR
      IF (I.EQ.M) FA=FA-2.0D0*X(KA)*X(KA-1)-0.5D0*X(KA-1)**2+1.5D0*X(KA)
     &**2*X(KA-1)*PAR
      IF (J.EQ.1) FA=FA-2.0D0*X(KA)*(X(KA+M)+1.0D0)-0.5D0*(X(KA+M)-
     &1.0D0)**2
      IF (J.GT.1.AND.J.LT.M) FA=FA-2.0D0*X(KA)*(X(KA+M)+X(KA-M))-0.5D0*
     &(X(KA+M)-X(KA-M))**2
      IF (J.EQ.M) FA=FA-2.0D0*X(KA)*X(KA-M)-0.5D0*X(KA-M)**2
      IF (I.EQ.1.AND.J.EQ.1) FA=FA-PAR/DBLE(M+1)
      RETURN
  300 FA=4.0D0*X(KA)
      A3=0.0D0
      J=(KA-1)/M+1
      I=KA-(J-1)*M
      A1=PAR*DBLE(I)
      A2=PAR*DBLE(J)
      FA=FA-2.0D3*A1*A2*(1.0D0-A1)*(1.0D0-A2)*PAR**2
      IF (I.GT.1) THEN
        FA=FA-X(KA-1)
        A3=A3-X(KA-1)
      END IF
      IF (I.LT.M) THEN
        FA=FA-X(KA+1)
        A3=A3+X(KA+1)
      END IF
      IF (J.GT.1) THEN
        FA=FA-X(KA-M)
        A3=A3-X(KA-M)
      END IF
      IF (J.LT.M) THEN
        FA=FA-X(KA+M)
        A3=A3+X(KA+M)
      END IF
      FA=FA+2.0D1*PAR*A3*X(KA)
      RETURN
  310 FA=2.0D1*X(KA)-PAR*MAX(0.0D0,X(KA))
      J=(KA-1)/M+1
      I=KA-(J-1)*M
      FA=FA-SIGN(PAR,(DBLE(I)/DBLE(M+2)-0.5D0))
      IF (J.GT.2) THEN
        FA=FA+X(KA-M-M)
      END IF
      IF (J.GT.1) THEN
        IF (I.GT.1) THEN
          FA=FA+2.0D0*X(KA-M-1)
        END IF
        FA=FA-8.0D0*X(KA-M)
        IF (I.LT.M) THEN
          FA=FA+2.0D0*X(KA-M+1)
        END IF
      END IF
      IF (I.GT.1) THEN
        IF (I.GT.2) THEN
          FA=FA+X(KA-2)
        END IF
        FA=FA-8.0D0*X(KA-1)
      END IF
      IF (I.LT.M) THEN
        FA=FA-8.0D0*X(KA+1)
        IF (I.LT.M-1) THEN
          FA=FA+X(KA+2)
        END IF
      END IF
      IF (J.LT.M) THEN
        IF (I.GT.1) THEN
          FA=FA+2.0D0*X(KA+M-1)
        END IF
        FA=FA-8.0D0*X(KA+M)
        IF (I.LT.M) THEN
          FA=FA+2.0D0*X(KA+M+1)
        END IF
      END IF
      IF (J.LT.M-1) THEN
        FA=FA+X(KA+M+M)
      END IF
      RETURN
  320 H=0.5D0/DBLE(M+2)
      J=(KA-1)/M+1
      I=KA-(J-1)*M
      FA=2.0D1*X(KA)
      A1=0.0D0
      A2=0.0D0
      A3=0.0D0
      A4=0.0D0
      IF (J.GT.2) THEN
        FA=FA+X(KA-M-M)
        A4=A4+X(KA-M-M)
      END IF
      IF (J.GT.1) THEN
        IF (I.GT.1) THEN
          FA=FA+2.0D0*X(KA-M-1)
          A3=A3+X(KA-M-1)
          A4=A4+X(KA-M-1)
        END IF
        FA=FA-8.0D0*X(KA-M)
        A1=A1-X(KA-M)
        A4=A4-4.0D0*X(KA-M)
        IF (I.LT.M) THEN
          FA=FA+2.0D0*X(KA-M+1)
          A3=A3-X(KA-M+1)
          A4=A4+X(KA-M+1)
        END IF
      END IF
      IF (I.GT.1) THEN
        IF (I.GT.2) THEN
          FA=FA+X(KA-2)
          A3=A3+X(KA-2)
        END IF
        FA=FA-8.0D0*X(KA-1)
        A2=A2-X(KA-1)
        A3=A3-4.0D0*X(KA-1)
      END IF
      IF (I.LT.M) THEN
        FA=FA-8.0D0*X(KA+1)
        A2=A2+X(KA+1)
        A3=A3+4.0D0*X(KA+1)
        IF (I.LT.M-1) THEN
          FA=FA+X(KA+2)
          A3=A3-X(KA+2)
        END IF
      END IF
      IF (J.LT.M) THEN
        IF (I.GT.1) THEN
          FA=FA+2.0D0*X(KA+M-1)
          A3=A3+X(KA+M-1)
          A4=A4-X(KA+M-1)
        END IF
        FA=FA-8.0D0*X(KA+M)
        A1=A1+X(KA+M)
        A4=A4+4.0D0*X(KA+M)
        IF (I.LT.M) THEN
          FA=FA+2.0D0*X(KA+M+1)
          A3=A3-X(KA+M+1)
          A4=A4-X(KA+M+1)
        END IF
      END IF
      IF (J.LT.M-1) THEN
        FA=FA+X(KA+M+M)
        A4=A4-X(KA+M+M)
      END IF
      IF (J.EQ.M) THEN
        IF (I.GT.1) THEN
          FA=FA-H-H
          A3=A3-H
          A4=A4+H
        END IF
        FA=FA+8.0D0*H
        A1=A1-H
        A4=A4-4.0D0*H
        IF (I.LT.M) THEN
          FA=FA-2.0D0*H
          A3=A3+H
          A4=A4+H
        END IF
        FA=FA+H
        A4=A4-H
      END IF
      IF (J.EQ.M-1) THEN
        FA=FA-H
        A4=A4+H
      END IF
      FA=FA+0.25D0*PAR*(A1*A3-A2*A4)
      RETURN
      END
! SUBROUTINE TAGU18             ALL SYSTEMS                 92/12/01
! PORTABILITY : ALL SYSTEMS
! 92/12/01 LU : ORIGINAL VERSION
!
! PURPOSE :
!  GRADIENTS OF TEST FUNCTIONS FOR NONLINEAR EQUATIONS.
!  UNIVERSAL VERSION.
!
! PARAMETERS :
!  II  N  NUMBER OF VARIABLES.
!  II  KA  INDEX OF THE APPROXIMATED FUNCTION.
!  RI  X(N)  VECTOR OF VARIABLES.
!  RO  GA(N)  GRADIENT OF THE APPROXIMATED FUNCTION AT THE
!          SELECTED POINT.
!  II  NEXT  NUMBER OF THE TEST PROBLEM.
!
      SUBROUTINE TAGU18 (N, KA, X, GA, NEXT)
      INTEGER I,J,K,M,N,KA,NEXT
      DOUBLE PRECISION X(*),GA(*)
      DOUBLE PRECISION GA1(2),GA2(2),GA3(6),GA4(6)
      DOUBLE PRECISION U,V,W,EX,PI,D1S,D2S,H,ALFA,A1,A2,A3,A4,PAR
      DATA PI/3.14159265358979323D0/
      COMMON /EMPR18/ PAR,M
      GO TO (10,20,30,50,60,70,80,90,100,110,120,130,140,150,160,180,
     &190,200,210,220,230,240,250,260,270,280,290,300,310,320,350,340),
     &NEXT
   10 ALFA=0.5D0
      IF (KA.EQ.1) THEN
        GA(1)=-1.0D0-4.0D0*X(2)
        GA(2)=-4.0D0*X(1)
        GA(3)=ALFA-1.0D0
      ELSE IF (KA.EQ.2) THEN
        GA(1)=-4.0D0*X(2)
        GA(2)=-1.0D0-4.0D0*X(1)
        GA(4)=-2.0D0+ALFA
      ELSE IF (KA.EQ.N-1) THEN
        GA(N-3)=ALFA
        GA(N-1)=-1.0D0-4.0D0*X(N)
        GA(N)=-4.0D0*X(N-1)
      ELSE IF (KA.EQ.N) THEN
        GA(N-2)=ALFA
        GA(N-1)=-4.0D0*X(N)
        GA(N)=-1.0D0-4.0D0*X(N-1)
      ELSE IF (MOD(KA,2).EQ.1) THEN
        GA(KA-2)=ALFA
        GA(KA)=-1.0D0-4.0D0*X(KA+1)
        GA(KA+1)=-4.0D0*X(KA)
        GA(KA+2)=-1.0D0+ALFA
      ELSE
        GA(KA-2)=ALFA
        GA(KA-1)=-4.0D0*X(KA)
        GA(KA)=-1.0D0-4.0D0*X(KA-1)
        GA(KA+2)=-2.0D0+ALFA
      END IF
      RETURN
   20 A1=0.414214D0
      IF (KA.EQ.1) THEN
        GA(1)=1.0D0+X(3)
        GA(2)=-4.0D0*A1
        GA(3)=-1.0D0+X(1)
      ELSE IF (KA.EQ.2) THEN
        GA(1)=X(4)
        GA(2)=-4.0D0*A1
        GA(4)=-1.0D0+X(1)
      ELSE IF (KA.EQ.3) THEN
        GA(1)=A1+X(5)
        GA(2)=-4.0D0*X(3)
        GA(3)=-1.0D0-4.0D0*X(2)
        GA(5)=-1.0D0+X(1)
      ELSE IF (KA.LE.N-2) THEN
        GA(1)=X(KA-2)+X(KA+2)
        GA(KA-2)=X(1)
        GA(KA-1)=-4.0D0*X(KA)
        GA(KA)=-1.0D0-4.0D0*X(KA-1)
        GA(KA+2)=-1.0D0+X(1)
      ELSE IF (KA.EQ.N-1) THEN
        GA(1)=X(N-3)
        GA(N-3)=X(1)
        GA(N-2)=-4.0D0*X(N-1)
        GA(N-1)=-1.0D0-4.0D0*X(N-2)
      ELSE
        GA(1)=X(N-2)+1.0D0
        GA(N-2)=X(1)
        GA(N-1)=-4.0D0*X(N)
        GA(N)=-1.0D0-4.0D0*X(N-1)
      END IF
      RETURN
   30 J=(KA-1)/5
      GA(KA)=-DBLE(J+1)*SIN(X(KA))-COS(X(KA))
      J=J*5
      DO 40 I=J+1,J+5
        IF (I.EQ.KA) THEN
          GA(I)=GA(I)+SIN(X(I))
        ELSE
          GA(I)=SIN(X(I))
        END IF
   40 CONTINUE
      RETURN
   50 IF (KA.LT.2) THEN
        D1S=COS(X(KA)-X(KA+1))*SIN(X(KA)+X(KA+1))
        D2S=SIN(X(KA)-X(KA+1))*COS(X(KA)+X(KA+1))
        GA(KA)=9.0D0*X(KA)**2+D1S+D2S
        GA(KA+1)=2.0D0-D1S+D2S
      ELSE IF (KA.LT.N) THEN
        D1S=COS(X(KA)-X(KA+1))*SIN(X(KA)+X(KA+1))
        D2S=SIN(X(KA)-X(KA+1))*COS(X(KA)+X(KA+1))
        EX=EXP(X(KA-1)-X(KA))
        GA(KA-1)=-EX-X(KA-1)*EX
        GA(KA)=9.0D0*X(KA)**2+D1S+D2S+4.0D0+X(KA-1)*EX
        GA(KA+1)=2.0D0-D1S+D2S
      ELSE
        EX=EXP(X(KA-1)-X(KA))
        GA(KA-1)=-EX-X(KA-1)*EX
        GA(KA)=4.0D0+X(KA-1)*EX
      END IF
      RETURN
   60 IF (MOD(KA,2).EQ.1) THEN
        GA(KA)=0.0D0
        IF (KA.NE.1) THEN
          D1S=COS(X(KA-2)-X(KA-1)-X(KA))*SIN(X(KA-2)+X(KA-1)-X(KA))
          D2S=SIN(X(KA-2)-X(KA-1)-X(KA))*COS(X(KA-2)+X(KA-1)-X(KA))
          GA(KA-2)=-18.0D0*(X(KA-2)-X(KA))**2-2.0D0*(D1S+D2S)
          GA(KA-1)=-4.0D0+2.0D0*(D1S-D2S)
          GA(KA)=GA(KA)+18.0D0*(X(KA-2)-X(KA))**2+2.0D0*(D1S+D2S)
        END IF
        IF (KA.NE.N) THEN
          D1S=COS(X(KA)-X(KA+1)-X(KA+2))*SIN(X(KA)+X(KA+1)-X(KA+2))
          D2S=SIN(X(KA)-X(KA+1)-X(KA+2))*COS(X(KA)+X(KA+1)-X(KA+2))
          GA(KA)=GA(KA)+9.0D0*(X(KA)-X(KA+2))**2+D1S+D2S
          GA(KA+1)=2.0D0-D1S+D2S
          GA(KA+2)=-9.0D0*(X(KA)-X(KA+2))**2-D1S-D2S
        END IF
      ELSE
        EX=EXP(X(KA-1)-X(KA)-X(KA+1))
        W=X(KA-1)-X(KA+1)
        GA(KA-1)=-EX-W*EX
        GA(KA)=4.0D0+W*EX
        GA(KA+1)=EX+W*EX
      END IF
      RETURN
   70 H=2.0D0
      IF (KA.EQ.1) THEN
        GA(1)=2.0D0*((3.0D0-H*X(1))*X(1)-2.0D0*X(2)+1.0D0)*(3.0D0-2.0D0*
     &   H*X(1))
        GA(2)=-4.0D0*((3.0D0-H*X(1))*X(1)-2.0D0*X(2)+1.0D0)
      ELSE IF (KA.LE.N-1) THEN
        GA(KA-1)=-2.0D0*((3.0D0-H*X(KA))*X(KA)-X(KA-1)-2.0D0*X(KA+1)+
     &   1.0D0)
        GA(KA)=2.0D0*((3.0D0-H*X(KA))*X(KA)-X(KA-1)-2.0D0*X(KA+1)+1.0D0)
     &   *(3.0D0-2.0D0*H*X(KA))
        GA(KA+1)=-4.0D0*((3.0D0-H*X(KA))*X(KA)-X(KA-1)-2.0D0*X(KA+1)+
     &   1.0D0)
      ELSE
        GA(N-1)=-2.0D0*((3.0D0-H*X(N))*X(N)-X(N-1)+1.0D0)
        GA(N)=2.0D0*((3.0D0-H*X(N))*X(N)-X(N-1)+1.0D0)*(3.0D0-2.0D0*H*
     &   X(N))
      END IF
      RETURN
   80 IF (KA.LT.2) THEN
        GA(KA)=4.0D0
        GA(KA+1)=-8.0D0*X(KA+1)
      ELSE IF (KA.LT.N) THEN
        GA(KA-1)=-8.0D0*X(KA)
        GA(KA)=24.0D0*X(KA)**2-8.0D0*X(KA-1)+6.0D0
        GA(KA+1)=-8.0D0*X(KA+1)
      ELSE
        GA(KA-1)=-8.0D0*X(KA)
        GA(KA)=24.0D0*X(KA)**2-8.0D0*X(KA-1)+2.0D0
      END IF
      RETURN
   90 IF (KA.LT.2) THEN
        GA(KA)=4.0D0
        GA(KA+1)=-8.0D0*X(KA+1)+1.0D0
        GA(KA+2)=-2.0D0*X(KA+2)
      ELSE IF (KA.LT.3) THEN
        GA(KA-1)=-8.0D0*X(KA)
        GA(KA)=24.0D0*X(KA)**2-8.0D0*X(KA-1)+6.0D0
        GA(KA+1)=-8.0D0*X(KA+1)+1.0D0
        GA(KA+2)=-2.0D0*X(KA+2)
      ELSE IF (KA.LT.N-1) THEN
        GA(KA-2)=-1.0D0
        GA(KA-1)=-8.0D0*X(KA)+2.0D0*X(KA-1)
        GA(KA)=24.0D0*X(KA)**2-8.0D0*X(KA-1)+6.0D0
        GA(KA+1)=-8.0D0*X(KA+1)+1.0D0
        GA(KA+2)=-2.0D0*X(KA+2)
      ELSE IF (KA.LT.N) THEN
        GA(KA-2)=-1.0D0
        GA(KA-1)=-8.0D0*X(KA)+2.0D0*X(KA-1)
        GA(KA)=24.0D0*X(KA)**2-8.0D0*X(KA-1)+6.0D0
        GA(KA+1)=-8.0D0*X(KA+1)
      ELSE
        GA(KA-2)=-1.0D0
        GA(KA-1)=-8.0D0*X(KA)+2.0D0*X(KA-1)
        GA(KA)=24.0D0*X(KA)**2-8.0D0*X(KA-1)+2.0D0
      END IF
      RETURN
  100 IF (KA.LT.2) THEN
        GA(KA)=4.0D0
        GA(KA+1)=-8.0D0*X(KA+1)+1.0D0
        GA(KA+2)=-2.0D0*X(KA+2)+1.0D0
        GA(KA+3)=-2.0D0*X(KA+3)
      ELSE IF (KA.LT.3) THEN
        GA(KA-1)=-8.0D0*X(KA)+2.0D0*X(KA-1)
        GA(KA)=24.0D0*X(KA)**2-8.0D0*X(KA-1)+6.0D0
        GA(KA+1)=-8.0D0*X(KA+1)+1.0D0
        GA(KA+2)=-2.0D0*X(KA+2)+1.0D0
        GA(KA+3)=-2.0D0*X(KA+3)
      ELSE IF (KA.LT.4) THEN
        GA(KA-2)=2.0D0*X(KA-2)-1.0D0
        GA(KA-1)=-8.0D0*X(KA)+2.0D0*X(KA-1)
        GA(KA)=24.0D0*X(KA)**2-8.0D0*X(KA-1)+6.0D0
        GA(KA+1)=-8.0D0*X(KA+1)+1.0D0
        GA(KA+2)=-2.0D0*X(KA+2)+1.0D0
        GA(KA+3)=-2.0D0*X(KA+3)
      ELSE IF (KA.LT.N-2) THEN
        GA(KA-3)=-1.0D0
        GA(KA-2)=2.0D0*X(KA-2)-1.0D0
        GA(KA-1)=-8.0D0*X(KA)+2.0D0*X(KA-1)
        GA(KA)=24.0D0*X(KA)**2-8.0D0*X(KA-1)+6.0D0
        GA(KA+1)=-8.0D0*X(KA+1)+1.0D0
        GA(KA+2)=-2.0D0*X(KA+2)+1.0D0
        GA(KA+3)=-2.0D0*X(KA+3)
      ELSE IF (KA.LT.N-1) THEN
        GA(KA-3)=-1.0D0
        GA(KA-2)=2.0D0*X(KA-2)-1.0D0
        GA(KA-1)=-8.0D0*X(KA)+2.0D0*X(KA-1)
        GA(KA)=24.0D0*X(KA)**2-8.0D0*X(KA-1)+6.0D0
        GA(KA+1)=-8.0D0*X(KA+1)+1.0D0
        GA(KA+2)=-2.0D0*X(KA+2)+1.0D0
      ELSE IF (KA.LT.N) THEN
        GA(KA-3)=-1.0D0
        GA(KA-2)=2.0D0*X(KA-2)-1.0D0
        GA(KA-1)=-8.0D0*X(KA)+2.0D0*X(KA-1)
        GA(KA)=24.0D0*X(KA)**2-8.0D0*X(KA-1)+6.0D0
        GA(KA+1)=-8.0D0*X(KA+1)+1.0D0
      ELSE
        GA(KA-3)=-1.0D0
        GA(KA-2)=2.0D0*X(KA-2)-1.0D0
        GA(KA-1)=-8.0D0*X(KA)+2.0D0*X(KA-1)
        GA(KA)=24.0D0*X(KA)**2-8.0D0*X(KA-1)+2.0D0
      END IF
      RETURN
  110 IF (KA.EQ.1) THEN
        GA(N-4)=3.0D0
        GA(N-3)=-1.0D0
        GA(N-2)=-1.0D0
        GA(N-1)=0.50D0
        GA(N)=-1.0D0
        GA(KA)=-4.0D0*X(KA)+3.0D0
        GA(KA+1)=-2.0D0
      ELSE IF (KA.LE.N-1) THEN
        GA(KA-1)=0.0D0
        GA(KA)=0.0D0
        GA(KA+1)=0.0D0
        GA(N-4)=3.0D0
        GA(N-3)=-1.0D0
        GA(N-2)=-1.0D0
        GA(N-1)=0.50D0
        GA(N)=-1.0D0
        GA(KA-1)=GA(KA-1)-1.0D0
        GA(KA)=GA(KA)-4.0D0*X(KA)+3.0D0
        GA(KA+1)=GA(KA+1)-2.0D0
      ELSE
        GA(N-4)=3.0D0
        GA(N-3)=-1.0D0
        GA(N-2)=-1.0D0
        GA(N-1)=-0.5D0
        GA(N)=-4.0D0*X(N)+2.0D0
      END IF
      RETURN
  120 IF (MOD(KA,2).EQ.1) THEN
        GA(KA)=1.0D0
        GA(KA+1)=10.0D0*X(KA+1)-3.0D0*X(KA+1)**2-2.0D0
      ELSE
        GA(KA-1)=1.0D0
        GA(KA)=3.0D0*X(KA)**2+2.0D0*X(KA)-1.4D1
      END IF
      RETURN
  130 IF (MOD(KA,4).EQ.1) THEN
        GA(KA)=1.0D0
        GA(KA+1)=1.0D1
      ELSE IF (MOD(KA,4).EQ.2) THEN
        GA(KA+1)=2.23606797749979D0
        GA(KA+2)=-GA(KA+1)
      ELSE IF (MOD(KA,4).EQ.3) THEN
        GA(KA-1)=2.0D0*(X(KA-1)-2.0D0*X(KA))
        GA(KA)=-4.0D0*(X(KA-1)-2.0D0*X(KA))
      ELSE
        GA(KA-3)=3.16227766016838D0*2.0D0*(X(KA-3)-X(KA))
        GA(KA)=-3.16227766016838D0*2.0D0*(X(KA-3)-X(KA))
      END IF
      RETURN
  140 IF (MOD(KA,4).EQ.1) THEN
        GA(KA)=2.0D0*(EXP(X(KA))-X(KA+1))*EXP(X(KA))
        GA(KA+1)=-2.0D0*(EXP(X(KA))-X(KA+1))
      ELSE IF (MOD(KA,4).EQ.2) THEN
        GA(KA)=3.0D1*(X(KA)-X(KA+1))**2
        GA(KA+1)=-GA(KA)
      ELSE IF (MOD(KA,4).EQ.3) THEN
        GA(KA)=2.0D0*SIN(X(KA)-X(KA+1))/(COS(X(KA)-X(KA+1)))**3
        GA(KA+1)=-GA(KA)
      ELSE
        GA(KA)=1.0D0
      END IF
      RETURN
  150 IF (KA.LT.2) THEN
        GA(KA)=X(KA)-3.0D0
        GA(KA+1)=2.0D0
      ELSE IF (KA.LT.N) THEN
        GA(KA-1)=1.0D0
        GA(KA)=X(KA)-3.0D0
        GA(KA+1)=2.0D0
      ELSE
        GA(KA-1)=1.0D0
        GA(KA)=X(KA)-3.0D0
      END IF
      RETURN
  160 DO 170 J=MAX(1,KA-5),MIN(N,KA+1)
        GA(J)=1.0D0+2.0D0*X(J)
  170 CONTINUE
      GA(KA)=GA(KA)+2.0D0+15.0D0*X(KA)**2
      RETURN
  180 IF (MOD(KA,2).EQ.1) THEN
        GA(KA)=1.0D4*X(KA+1)
        GA(KA+1)=1.0D4*X(KA)
      ELSE
        GA(KA-1)=-EXP(-X(KA-1))
        GA(KA)=-EXP(-X(KA))
      END IF
      RETURN
  190 IF (MOD(KA,4).EQ.1) THEN
        GA(KA)=-2.0D2*(X(KA+1)-3.0D0*X(KA)**2)+1.0D0
        GA(KA+1)=-2.0D2*X(KA)
      ELSE IF (MOD(KA,4).EQ.2) THEN
        GA(KA-1)=-4.0D2*X(KA-1)
        GA(KA)=2.202D2
        GA(KA+2)=1.98D1
      ELSE IF (MOD(KA,4).EQ.3) THEN
        GA(KA)=-1.8D2*(X(KA+1)-3.0D0*X(KA)**2)+1.0D0
        GA(KA+1)=-1.8D2*X(KA)
      ELSE
        GA(KA-2)=1.98D1
        GA(KA-1)=-3.6D2*X(KA-1)
        GA(KA)=2.002D2
      END IF
      RETURN
  200 IF (KA.LT.2) THEN
        GA(KA+1)=EXP(COS(DBLE(KA)*(X(KA)+X(KA+1))))*DBLE(KA)*
     &   SIN(DBLE(KA)*(X(KA)+X(KA+1)))
        GA(KA)=GA(KA+1)+1.0D0
      ELSE IF (KA.LT.N) THEN
        GA(KA-1)=EXP(COS(DBLE(KA)*(X(KA-1)+X(KA)+X(KA+1))))*SIN(DBLE(KA)
     &   *(X(KA-1)+X(KA)+X(KA+1)))*DBLE(KA)
        GA(KA+1)=GA(KA-1)
        GA(KA)=1.0D0+GA(KA-1)
      ELSE
        GA(KA-1)=EXP(COS(DBLE(KA)*(X(KA-1)+X(KA))))*SIN(DBLE(KA)*(X(KA-
     &   1)+X(KA)))*DBLE(KA)
        GA(KA)=1.0D0+GA(KA-1)
      END IF
      RETURN
  210 U=1.0D0/DBLE(N+1)
      V=DBLE(KA)*U
      GA(KA)=2.0D0+1.5D0*U**2*(X(KA)+V+1.0D0)**2
      IF (KA.GT.1) GA(KA-1)=-1.0D0
      IF (KA.LT.N) GA(KA+1)=-1.0D0
      RETURN
  220 IF (KA.EQ.1) THEN
        GA(KA)=3.0D0*(X(KA+1)-4.0D0*X(KA))
        GA(KA+1)=3.0D0*X(KA)+0.5D0*X(KA+1)
      ELSE IF (KA.EQ.N) THEN
        GA(KA-1)=3.0D0*X(KA)-0.5D0*(2.0D1-X(KA-1))
        GA(KA)=3.0D0*(2.0D1-4.0D0*X(KA)+X(KA-1))
      ELSE
        GA(KA-1)=3.0D0*X(KA)-0.5D0*(X(KA+1)-X(KA-1))
        GA(KA)=3.0D0*(X(KA+1)-4.0D0*X(KA)+X(KA-1))
        GA(KA+1)=3.0D0*X(KA)+0.5D0*(X(KA+1)-X(KA-1))
      END IF
      RETURN
  230 H=1.0D0/DBLE(N+1)
      IF (KA.LT.2) THEN
        GA(KA)=2.0D0+PAR**2*H**2*COSH(PAR*X(KA))
        GA(KA+1)=-1.0D0
      ELSE IF (KA.LT.N) THEN
        GA(KA-1)=-1.0D0
        GA(KA)=2.0D0+PAR**2*H**2*COSH(PAR*X(KA))
        GA(KA+1)=-1.0D0
      ELSE
        GA(KA)=2.0D0+PAR**2*H**2*COSH(PAR*X(KA))
        GA(KA-1)=-1.0D0
      END IF
      RETURN
  240 GA(KA)=6.0D0
!      FA=6.0D 0*X(KA)
      A1=0.0D0
      A2=0.0D0
      A3=0.0D0
      GA1(1)=0.0D0
      GA1(2)=0.0D0
      GA2(1)=0.0D0
      GA2(2)=0.0D0
      IF (KA.GT.1) THEN
        GA(KA-1)=-4.0D0+PAR*X(KA)
        A1=A1-X(KA-1)
        A2=A2+X(KA-1)
        A3=A3+2.0D0*X(KA-1)
        GA1(1)=-1.0D0
        GA2(1)=1.0D0
      END IF
      IF (KA.GT.2) THEN
        GA(KA-2)=1.0D0-0.5D0*PAR*X(KA)
        A3=A3-X(KA-2)
      END IF
      IF (KA.LT.N-1) THEN
        GA(KA+2)=1.0D0+0.5D0*PAR*X(KA)
        A3=A3+X(KA+2)
      END IF
      IF (KA.LT.N) THEN
        GA(KA+1)=-4.0D0-PAR*X(KA)
        A1=A1+X(KA+1)
        A2=A2+X(KA+1)
        A3=A3-2.0D0*X(KA+1)
        GA1(2)=1.0D0
        GA2(2)=1.0D0
      END IF
      IF (KA.GE.N-1) THEN
        A3=A3+1.0D0
      END IF
      IF (KA.GE.N) THEN
        A1=A1+1.0D0
        A2=A2+1.0D0
        A3=A3-2.0D0
      END IF
      GA(KA)=GA(KA)+0.5D0*PAR*A3
      IF (KA.GT.1) GA(KA-1)=GA(KA-1)-0.5D0*PAR*(GA1(1)*A2+A1*GA2(1))
      IF (KA.LT.N) GA(KA+1)=GA(KA+1)-0.5D0*PAR*(GA1(2)*A2+A1*GA2(2))
      RETURN
  250 H=1.0D0/(M+1)
      IF (KA.LE.M) THEN
        J=KA+M
        GA(KA)=6.0D0
        GA(J)=0.0D0
        A1=0.0D0
        A2=0.0D0
        IF (KA.EQ.1) THEN
          A1=A1+1.0D0
        END IF
        IF (KA.GT.1) THEN
          A1=A1-X(J-1)
          A2=A2+2.0D0*X(KA-1)
          GA(KA-1)=-4.0D0+PAR*H*X(KA)
          GA(J-1)=-0.5D0*PAR*H**3*X(J)
        END IF
        IF (KA.GT.2) THEN
          A2=A2-X(KA-2)
          GA(KA-2)=1.0D0-0.5D0*PAR*H*X(KA)
        END IF
        IF (KA.LT.M-1) THEN
          A2=A2+X(KA+2)
          GA(KA+2)=1.0D0+0.5D0*PAR*H*X(KA)
        END IF
        IF (KA.LT.M) THEN
          A1=A1+X(J+1)
          A2=A2-2.0D0*X(KA+1)
          GA(KA+1)=-4.0D0-PAR*H*X(KA)
          GA(J+1)=0.5D0*PAR*H**3*X(J)
        END IF
        IF (KA.EQ.M) THEN
          A1=A1+1.0D0
        END IF
        GA(KA)=GA(KA)+0.5D0*PAR*H*A2
        GA(J)=GA(J)+0.5D0*PAR*H**3*A1
      ELSE
        J=KA-M
        GA(KA)=-2.0D0
        GA(J)=0.0D0
        A1=0.0D0
        A2=0.0D0
        IF (J.EQ.1) THEN
          A2=A2+1.0D0
        END IF
        IF (J.GT.1) THEN
          A1=A1-X(J-1)
          A2=A2-X(KA-1)
          GA(KA-1)=1.0D0-0.5D0*PAR*H*X(J)
          GA(J-1)=-0.5D0*PAR*H*X(KA)
        END IF
        IF (J.LT.M) THEN
          A1=A1+X(J+1)
          A2=A2+X(KA+1)
          GA(KA+1)=1.0D0+0.5D0*PAR*H*X(J)
          GA(J+1)=0.5D0*PAR*H*X(KA)
        END IF
        IF (J.EQ.M) THEN
          A2=A2+1.0D0
        END IF
        GA(KA)=GA(KA)+0.5D0*PAR*H*A1
        GA(J)=GA(J)+0.5D0*PAR*H*A2
      END IF
      RETURN
  260 GA(KA)=4.0D0-PAR*EXP(X(KA))
      J=(KA-1)/M+1
      I=KA-(J-1)*M
      IF (J.GT.1) GA(KA-M)=-1.0D0
      IF (I.GT.1) GA(KA-1)=-1.0D0
      IF (I.LT.M) GA(KA+1)=-1.0D0
      IF (J.LT.M) GA(KA+M)=-1.0D0
      RETURN
  270 GA(KA)=4.0D0
      J=(KA-1)/M+1
      I=KA-(J-1)*M
      GA(KA)=GA(KA)+3.0D0*PAR*X(KA)**2/(1.0D0+PAR*DBLE(I)**2+PAR*DBLE(J)
     &**2)
      IF (I.GT.1) GA(KA-1)=-1.0D0
      IF (I.LT.M) GA(KA+1)=-1.0D0
      IF (J.GT.1) GA(KA-M)=-1.0D0
      IF (J.LT.M) GA(KA+M)=-1.0D0
      RETURN
  280 GA(KA)=4.0D0-2.0D0*PI*PAR*COS(2.0D0*PI*X(KA))
      J=(KA-1)/M+1
      I=KA-(J-1)*M
      A1=DBLE(I)/DBLE(M+1)
      A2=DBLE(J)/DBLE(M+1)
      IF (I.EQ.1) GA(KA+1)=-1.0D0-PI*DBLE(M+1)*PAR*COS(PI*X(KA+1)*
     &DBLE(M+1))
      IF (I.GT.1.AND.I.LT.M) THEN
        GA(KA-1)=-1.0D0+PI*DBLE(M+1)*PAR*COS(PI*(X(KA+1)-X(KA-1))*
     &   DBLE(M+1))
        GA(KA+1)=-1.0D0-PI*DBLE(M+1)*PAR*COS(PI*(X(KA+1)-X(KA-1))*
     &   DBLE(M+1))
      END IF
      IF (I.EQ.M) GA(KA-1)=-1.0D0+PI*DBLE(M+1)*PAR*COS(PI*X(KA-1)*
     &DBLE(M+1))
      IF (J.EQ.1) GA(KA+M)=-1.0D0-PI*DBLE(M+1)*PAR*COS(PI*X(KA+M)*
     &DBLE(M+1))
      IF (J.GT.1.AND.J.LT.M) THEN
        GA(KA-M)=-1.0D0+PI*DBLE(M+1)*PAR*COS(PI*(X(KA+M)-X(KA-M))*
     &   DBLE(M+1))
        GA(KA+M)=-1.0D0-PI*DBLE(M+1)*PAR*COS(PI*(X(KA+M)-X(KA-M))*
     &   DBLE(M+1))
      END IF
      IF (J.EQ.M) GA(KA-M)=-1.0D0+PI*DBLE(M+1)*PAR*COS(PI*X(KA-M)*
     &DBLE(M+1))
      RETURN
  290 GA(KA)=1.6D1*X(KA)
      J=(KA-1)/M+1
      I=KA-(J-1)*M
      IF (I.EQ.1) THEN
        GA(KA)=GA(KA)-2.0D0*(X(KA+1)+1.0D0)-3.0D0*X(KA)*(X(KA+1)-1.0D0)*
     &   PAR
        GA(KA+1)=-2.0D0*X(KA)-(X(KA+1)-1.0D0)-1.5D0*X(KA)**2*PAR
      END IF
      IF (I.GT.1.AND.I.LT.M) THEN
        GA(KA)=GA(KA)-2.0D0*(X(KA+1)+X(KA-1))-3.0D0*X(KA)*(X(KA+1)-X(KA-
     &   1))*PAR
        GA(KA-1)=-2.0D0*X(KA)+(X(KA+1)-X(KA-1))+1.5D0*X(KA)**2*PAR
        GA(KA+1)=-2.0D0*X(KA)-(X(KA+1)-X(KA-1))-1.5D0*X(KA)**2*PAR
      END IF
      IF (I.EQ.M) THEN
        GA(KA)=GA(KA)-2.0D0*X(KA-1)+3.0D0*X(KA)*X(KA-1)*PAR
        GA(KA-1)=-2.0D0*X(KA)-X(KA-1)+1.5D0*X(KA)**2*PAR
      END IF
      IF (J.EQ.1) THEN
        GA(KA)=GA(KA)-2.0D0*(X(KA+M)+1.0D0)
        GA(KA+M)=-2.0D0*X(KA)-(X(KA+M)-1.0D0)
      END IF
      IF (J.GT.1.AND.J.LT.M) THEN
        GA(KA)=GA(KA)-2.0D0*(X(KA+M)+X(KA-M))
        GA(KA-M)=-2.0D0*X(KA)+(X(KA+M)-X(KA-M))
        GA(KA+M)=-2.0D0*X(KA)-(X(KA+M)-X(KA-M))
      END IF
      IF (J.EQ.M) THEN
        GA(KA)=GA(KA)-2.0D0*X(KA-M)
        GA(KA-M)=-2.0D0*X(KA)-X(KA-M)
      END IF
      RETURN
  300 GA(KA)=4.0D0
      J=(KA-1)/M+1
      I=KA-(J-1)*M
      A1=PAR*DBLE(I)
      A2=PAR*DBLE(J)
      A3=0.0D0
      IF (I.GT.1) THEN
        GA(KA-1)=-1.0D0-2.0D1*PAR*X(KA)
        A3=A3-X(KA-1)
      END IF
      IF (I.LT.M) THEN
        GA(KA+1)=-1.0D0+2.0D1*PAR*X(KA)
        A3=A3+X(KA+1)
      END IF
      IF (J.GT.1) THEN
        GA(KA-M)=-1.0D0-2.0D1*PAR*X(KA)
        A3=A3-X(KA-M)
      END IF
      IF (J.LT.M) THEN
        GA(KA+M)=-1.0D0+2.0D1*PAR*X(KA)
        A3=A3+X(KA+M)
      END IF
      GA(KA)=GA(KA)+2.0D1*PAR*A3
      RETURN
  310 GA(KA)=2.0D1-PAR
      J=(KA-1)/M+1
      I=KA-(J-1)*M
      IF (J.GT.2) THEN
        GA(KA-M-M)=1.0D0
      END IF
      IF (J.GT.1) THEN
        IF (I.GT.1) THEN
          GA(KA-M-1)=2.0D0
        END IF
        GA(KA-M)=-8.0D0
        IF (I.LT.M) THEN
          GA(KA-M+1)=2.0D0
        END IF
      END IF
      IF (I.GT.1) THEN
        IF (I.GT.2) THEN
          GA(KA-2)=1.0D0
        END IF
        GA(KA-1)=-8.0D0
      END IF
      IF (I.LT.M) THEN
        GA(KA+1)=-8.0D0
        IF (I.LT.M-1) THEN
          GA(KA+2)=1.0D0
        END IF
      END IF
      IF (J.LT.M) THEN
        IF (I.GT.1) THEN
          GA(KA+M-1)=2.0D0
        END IF
        GA(KA+M)=-8.0D0
        IF (I.LT.M) THEN
          GA(KA+M+1)=2.0D0
        END IF
      END IF
      IF (J.LT.M-1) THEN
        GA(KA+M+M)=1.0D0
      END IF
      RETURN
  320 H=0.5D0/DBLE(M+2)
      J=(KA-1)/M+1
      I=KA-(J-1)*M
      GA(KA)=2.0D1
      A1=0.0D0
      A2=0.0D0
      A3=0.0D0
      A4=0.0D0
      GA1(1)=0.0D0
      GA1(2)=0.0D0
      GA2(1)=0.0D0
      GA2(2)=0.0D0
      DO 330 K=1,6
        GA3(K)=0.0D0
        GA4(K)=0.0D0
  330 CONTINUE
      IF (J.GT.2) THEN
        GA(KA-M-M)=1.0D0
        GA4(1)=GA4(1)+1.0D0
        A4=A4+X(KA-M-M)
      END IF
      IF (J.GT.1) THEN
        IF (I.GT.1) THEN
          GA(KA-M-1)=2.0D0
          GA3(1)=GA3(1)+1.0D0
          GA4(2)=GA4(2)+1.0D0
          A3=A3+X(KA-M-1)
          A4=A4+X(KA-M-1)
        END IF
        GA(KA-M)=-8.0D0
        GA1(1)=GA1(1)-1.0D0
        A1=A1-X(KA-M)
        IF (I.LT.M) THEN
          GA(KA-M+1)=2.0D0
          GA3(2)=GA3(2)-1.0D0
          GA4(3)=GA4(3)+1.0D0
          A3=A3-X(KA-M+1)
          A4=A4+X(KA-M+1)
        END IF
      END IF
      IF (I.GT.1) THEN
        IF (I.GT.2) THEN
          GA(KA-2)=1.0D0
          GA3(3)=GA3(3)+1.0D0
          A3=A3+X(KA-2)
        END IF
        GA(KA-1)=-8.0D0
        GA2(1)=GA2(1)-1.0D0
        A2=A2-X(KA-1)
      END IF
      IF (I.LT.M) THEN
        GA(KA+1)=-8.0D0
        GA2(2)=GA2(2)+1.0D0
        A2=A2+X(KA+1)
        IF (I.LT.M-1) THEN
          GA(KA+2)=1.0D0
          GA3(4)=GA3(4)-1.0D0
          A3=A3-X(KA+2)
        END IF
      END IF
      IF (J.LT.M) THEN
        IF (I.GT.1) THEN
          GA(KA+M-1)=2.0D0
          GA3(5)=GA3(5)+1.0D0
          GA4(4)=GA4(4)-1.0D0
          A3=A3+X(KA+M-1)
          A4=A4-X(KA+M-1)
        END IF
        GA(KA+M)=-8.0D0
        GA1(2)=GA1(2)+1.0D0
        A1=A1+X(KA+M)
        IF (I.LT.M) THEN
          GA(KA+M+1)=2.0D0
          GA3(6)=GA3(6)-1.0D0
          GA4(5)=GA4(5)-1.0D0
          A3=A3-X(KA+M+1)
          A4=A4-X(KA+M+1)
        END IF
      END IF
      IF (J.LT.M-1) THEN
        GA(KA+M+M)=1.0D0
        GA4(6)=GA4(6)-1.0D0
        A4=A4-X(KA+M+M)
      END IF
      IF (J.EQ.M) THEN
        IF (I.GT.1) THEN
          A3=A3-H
          A4=A4+H
        END IF
        A1=A1-H
        IF (I.LT.M) THEN
          A3=A3+H
          A4=A4+H
        END IF
        A4=A4-H
      END IF
      IF (J.EQ.M-1) THEN
        A4=A4+H
      END IF
      IF (KA.GT.M+M) GA(KA-M-M)=GA(KA-M-M)+0.25D0*PAR*(-A2*GA4(1))
      IF (KA.GT.M+1) GA(KA-M-1)=GA(KA-M-1)+0.25D0*PAR*(+A1*GA3(1)-A2*
     &GA4(2))
      IF (KA.GT.M) GA(KA-M)=GA(KA-M)+0.25D0*PAR*(GA1(1)*A3)
      IF (KA.GT.M-1) GA(KA-M+1)=GA(KA-M+1)+0.25D0*PAR*(+A1*GA3(2)-A2*
     &GA4(3))
      IF (KA.GT.2) GA(KA-2)=GA(KA-2)+0.25D0*PAR*(+A1*GA3(3))
      IF (KA.GT.1) GA(KA-1)=GA(KA-1)+0.25D0*PAR*(-GA2(1)*A4)
      IF (KA.LE.N-1) GA(KA+1)=GA(KA+1)+0.25D0*PAR*(-GA2(2)*A4)
      IF (KA.LE.N-2) GA(KA+2)=GA(KA+2)+0.25D0*PAR*(+A1*GA3(4))
      IF (KA.LE.N-M+1) GA(KA+M-1)=GA(KA+M-1)+0.25D0*PAR*(+A1*GA3(5)-A2*
     &GA4(4))
      IF (KA.LE.N-M) GA(KA+M)=GA(KA+M)+0.25D0*PAR*(GA1(2)*A3)
      IF (KA.LE.N-M-1) GA(KA+M+1)=GA(KA+M+1)+0.25D0*PAR*(+A1*GA3(6)-A2*
     &GA4(5))
      IF (KA.LE.N-M-M) GA(KA+M+M)=GA(KA+M+M)+0.25D0*PAR*(-A2*GA4(6))
      RETURN
  340 H=1.0D0/DBLE(N+1)
      A1=DBLE(KA)*H
      A2=(A1-0.5D0)**2
      IF (A1.GE.0.5D0) THEN
        A3=1.0D6
      ELSE
        A3=-1.0D6
      END IF
      IF (KA.LT.2) THEN
        GA(KA)=2.0D0+H**2*(3.0D0*X(KA)**2*EXP(X(KA))+X(KA)**3*EXP(X(KA))
     &   )
        GA(KA+1)=-1.0D0+H**2*5.0D8*EXP(-1.0D4*A2)*SQRT(ABS(A1-0.5D0))
      ELSE IF (KA.LT.N) THEN
        GA(KA-1)=-1.0D0-H**2*5.0D8*EXP(-1.0D4*A2)*SQRT(ABS(A1-0.5D0))
        GA(KA)=2.0D0+H**2*(3.0D0*X(KA)**2*EXP(X(KA))+X(KA)**3*EXP(X(KA))
     &   )
        GA(KA+1)=-1.0D0+H**2*5.0D8*EXP(-1.0D4*A2)*SQRT(ABS(A1-0.5D0))
      ELSE
        GA(KA-1)=-1.0D0+H**2*5.0D8*EXP(-1.0D4*A2)*SQRT(ABS(A1-0.5D0))
        GA(KA)=2.0D0+H**2*(3.0D0*X(KA)**2*EXP(X(KA))+X(KA)**3*EXP(X(KA))
     &   )
      END IF
      RETURN
  350 H=1.0D0/DBLE(N+1)
      A1=DBLE(KA)*H
      A2=(A1-0.5D0)**2
      IF (KA.LT.2) THEN
        GA(KA+1)=-1.0D0
        GA(KA)=2.0D0+H**2*(3*X(KA)**2+2.0D-4*(2.0D-4*A2-1.0D0))
      ELSE IF (KA.LT.N) THEN
        GA(KA-1)=-1.0D0
        GA(KA)=2.0D0+H**2*(3*X(KA)**2+2.0D-4*(2.0D-4*A2-1.0D0))
        GA(KA+1)=-1.0D0
      ELSE
        GA(KA-1)=-1.0D0
        GA(KA)=2.0D0+H**2*(3*X(KA)**2+2.0D-4*(2.0D-4*A2-1.0D0))
      END IF
      RETURN
      END
! SUBROUTINE TYTIM1                MS DOS                     91/12/01
! PORTABILITY : MS DOS / MS FORTRAN V.5.0
! 91/12/01 SI : ORIGINAL VERSION
!
! PURPOSE :
!  GET TIME IN 100TH OF SEC.
!
      SUBROUTINE TYTIM1 (ITIME)
      INTEGER ITIME
      REAL TIME
      CALL CPU_TIME (TIME)
      ITIME=1.0D2*TIME
      END
! SUBROUTINE TYTIM2                ALL SYSTEMS                91/12/01
! PORTABILITY : ALL SYSTEMS
! 91/12/01 SI : ORIGINAL VERSION
!
! PURPOSE :
!  PRINT TIME ELAPSED.
!
      SUBROUTINE TYTIM2 (ITIME)
      INTEGER ITIME
      INTEGER IHR,IT,IMIN,ISEC
      CALL TYTIM1 (IT)
      IT=IT-ITIME
      IHR=IT/(60*60*100)
      IT=IT-IHR*60*60*100
      IMIN=IT/(60*100)
      IT=IT-IMIN*60*100
      ISEC=IT/100
      IT=IT-ISEC*100
      WRITE (6,10) IHR,IMIN,ISEC,IT
   10 FORMAT (' TIME=',I2,':',I2.2,':',I2.2,'.',I2.2)
      END

