C
C SPDX-License-Identifier: BSD-3-Clause
C
      SUBROUTINE IB03BD( INIT, NOBR, M, L, NSMP, N, NN, ITMAX1, ITMAX2,
     $                   NPRINT, U, LDU, Y, LDY, X, LX, TOL1, TOL2,
     $                   IWORK, DWORK, LDWORK, IWARN, INFO )
C
C     PURPOSE
C
C     To compute a set of parameters for approximating a Wiener system
C     in a least-squares sense, using a neural network approach and a
C     MINPACK-like Levenberg-Marquardt algorithm. The Wiener system
C     consists of a linear part and a static nonlinearity, and it is
C     represented as
C
C        x(t+1) = A*x(t) + B*u(t)
C        z(t)   = C*x(t) + D*u(t),
C
C        y(t)   = f(z(t),wb(1:L)),
C
C     where t = 1, 2, ..., NSMP, and f is a nonlinear function,
C     evaluated by the SLICOT Library routine NF01AY. The parameter
C     vector X is partitioned as X = ( wb(1), ..., wb(L), theta ),
C     where theta corresponds to the linear part, and wb(i), i = 1 : L,
C     correspond to the nonlinear part. See SLICOT Library routine
C     NF01AD for further details.
C
C     The sum of squares of the error functions, defined by
C
C        e(t) = y(t) - Y(t),  t = 1, 2, ..., NSMP,
C
C     is minimized, where Y(t) is the measured output vector. The
C     functions and their Jacobian matrices are evaluated by SLICOT
C     Library routine NF01BF (the FCN routine in the call of MD03BD).
C
C     ARGUMENTS
C
C     Mode Parameters
C
C     INIT    CHARACTER*1
C             Specifies which parts have to be initialized, as follows:
C             = 'L' : initialize the linear part only, X already
C                     contains an initial approximation of the
C                     nonlinearity;
C             = 'S' : initialize the static nonlinearity only, X
C                     already contains an initial approximation of the
C                     linear part;
C             = 'B' : initialize both linear and nonlinear parts;
C             = 'N' : do not initialize anything, X already contains
C                     an initial approximation.
C             If INIT = 'S' or 'B', the error functions for the
C             nonlinear part, and their Jacobian matrices, are evaluated
C             by SLICOT Library routine NF01BE (used as a second FCN
C             routine in the MD03BD call for the initialization step,
C             see METHOD).
C
C     Input/Output Parameters
C
C     NOBR    (input) INTEGER
C             If INIT = 'L' or 'B', NOBR is the number of block rows, s,
C             in the input and output block Hankel matrices to be
C             processed for estimating the linear part.  NOBR > 0.
C             (In the MOESP theory,  NOBR  should be larger than  n,
C             the estimated dimension of state vector.)
C             This parameter is ignored if INIT is 'S' or 'N'.
C
C     M       (input) INTEGER
C             The number of system inputs.  M >= 0.
C
C     L       (input) INTEGER
C             The number of system outputs.  L >= 0, and L > 0, if
C             INIT = 'L' or 'B'.
C
C     NSMP    (input) INTEGER
C             The number of input and output samples, t.  NSMP >= 0, and
C             NSMP >= 2*(M+L+1)*NOBR - 1, if INIT = 'L' or 'B'.
C
C     N       (input/output) INTEGER
C             The order of the linear part.
C             If INIT = 'L' or 'B', and N < 0 on entry, the order is
C             assumed unknown and it will be found by the routine.
C             Otherwise, the input value will be used. If INIT = 'S'
C             or 'N', N must be non-negative. The values N >= NOBR,
C             or N = 0, are not acceptable if INIT = 'L' or 'B'.
C
C     NN      (input) INTEGER
C             The number of neurons which shall be used to approximate
C             the nonlinear part.  NN >= 0.
C
C     ITMAX1  (input) INTEGER
C             The maximum number of iterations for the initialization of
C             the static nonlinearity.
C             This parameter is ignored if INIT is 'N' or 'L'.
C             Otherwise, ITMAX1 >= 0.
C
C     ITMAX2  (input) INTEGER
C             The maximum number of iterations.  ITMAX2 >= 0.
C
C     NPRINT  (input) INTEGER
C             This parameter enables controlled printing of iterates if
C             it is positive. In this case, FCN is called with IFLAG = 0
C             at the beginning of the first iteration and every NPRINT
C             iterations thereafter and immediately prior to return,
C             and the current error norm is printed. Other intermediate
C             results could be printed by modifying the corresponding
C             FCN routine (NF01BE and/or NF01BF). If NPRINT <= 0, no
C             special calls of FCN with IFLAG = 0 are made.
C
C     U       (input) DOUBLE PRECISION array, dimension (LDU, M)
C             The leading NSMP-by-M part of this array must contain the
C             set of input samples,
C             U = ( U(1,1),...,U(1,M); ...; U(NSMP,1),...,U(NSMP,M) ).
C
C     LDU     INTEGER
C             The leading dimension of array U.  LDU >= MAX(1,NSMP).
C
C     Y       (input) DOUBLE PRECISION array, dimension (LDY, L)
C             The leading NSMP-by-L part of this array must contain the
C             set of output samples,
C             Y = ( Y(1,1),...,Y(1,L); ...; Y(NSMP,1),...,Y(NSMP,L) ).
C
C     LDY     INTEGER
C             The leading dimension of array Y.  LDY >= MAX(1,NSMP).
C
C     X       (input/output) DOUBLE PRECISION array dimension (LX)
C             On entry, if INIT = 'L', the leading (NN*(L+2) + 1)*L part
C             of this array must contain the initial parameters for
C             the nonlinear part of the system.
C             On entry, if INIT = 'S', the elements lin1 : lin2 of this
C             array must contain the initial parameters for the linear
C             part of the system, corresponding to the output normal
C             form, computed by SLICOT Library routine TB01VD, where
C                lin1 = (NN*(L+2) + 1)*L + 1;
C                lin2 = (NN*(L+2) + 1)*L + N*(L+M+1) + L*M.
C             On entry, if INIT = 'N', the elements 1 : lin2 of this
C             array must contain the initial parameters for the
C             nonlinear part followed by the initial parameters for the
C             linear part of the system, as specified above.
C             This array need not be set on entry if INIT = 'B'.
C             On exit, the elements 1 : lin2 of this array contain the
C             optimal parameters for the nonlinear part followed by the
C             optimal parameters for the linear part of the system, as
C             specified above.
C
C     LX      (input/output) INTEGER
C             On entry, this parameter must contain the intended length
C             of X. If N >= 0, then LX >= NX := lin2 (see parameter X).
C             If N is unknown (N < 0 on entry), a large enough estimate
C             of N should be used in the formula of lin2.
C             On exit, if N < 0 on entry, but LX is not large enough,
C             then this parameter contains the actual length of X,
C             corresponding to the computed N. Otherwise, its value
C             is unchanged.
C
C     Tolerances
C
C     TOL1    DOUBLE PRECISION
C             If INIT = 'S' or 'B' and TOL1 >= 0, TOL1 is the tolerance
C             which measures the relative error desired in the sum of
C             squares, as well as the relative error desired in the
C             approximate solution, for the initialization step of
C             nonlinear part. Termination occurs when either both the
C             actual and predicted relative reductions in the sum of
C             squares, or the relative error between two consecutive
C             iterates are at most TOL1. If the user sets  TOL1 < 0,
C             then  SQRT(EPS)  is used instead TOL1, where EPS is the
C             machine precision (see LAPACK Library routine DLAMCH).
C             This parameter is ignored if INIT is 'N' or 'L'.
C
C     TOL2    DOUBLE PRECISION
C             If TOL2 >= 0, TOL2 is the tolerance which measures the
C             relative error desired in the sum of squares, as well as
C             the relative error desired in the approximate solution,
C             for the whole optimization process. Termination occurs
C             when either both the actual and predicted relative
C             reductions in the sum of squares, or the relative error
C             between two consecutive iterates are at most TOL2. If the
C             user sets TOL2 < 0, then  SQRT(EPS)  is used instead TOL2.
C             This default value could require many iterations,
C             especially if TOL1 is larger. If INIT = 'S' or 'B', it is
C             advisable that TOL2 be larger than TOL1, and spend more
C             time with cheaper iterations.
C
C     Workspace
C
C     IWORK   INTEGER array, dimension (MAX( LIW1, LIW2, LIW3 )), where
C             LIW1 = LIW2 = 0,  if INIT = 'S' or 'N'; otherwise,
C             LIW1 = M+L;
C             LIW2 = MAX(M*NOBR+N,M*(N+L));
C             LIW3 = 3+MAX(NN*(L+2)+2,NX+L), if INIT = 'S' or 'B';
C             LIW3 = 3+NX+L,                 if INIT = 'L' or 'N'.
C             On output, if INFO = 0, IWORK(1) and IWORK(2) return the
C             (total) number of function and Jacobian evaluations,
C             respectively (including the initialization step, if it was
C             performed), and if INIT = 'L' or INIT = 'B', IWORK(3)
C             specifies how many locations of DWORK contain reciprocal
C             condition number estimates (see below); otherwise,
C             IWORK(3) = 0. If INFO = 0, the entries 4 to 3+NX of IWORK
C             define a permutation matrix P such that J*P = Q*R, where
C             J is the final calculated Jacobian, Q is an orthogonal
C             matrix (not stored), and R is upper triangular with
C             diagonal elements of nonincreasing magnitude (possibly
C             for each block column of J). Column j of P is column
C             IWORK(3+j) of the identity matrix. Moreover, the entries
C             4+NX:3+NX+L of this array contain the ranks of the final
C             submatrices S_k (see description of LMPARM in MD03BD).
C
C     DWORK   DOUBLE PRECISION array, dimension (LDWORK)
C             On entry, if desired, and if INIT = 'S' or 'B', the
C             entries DWORK(1:4) are set to initialize the random
C             numbers generator for the nonlinear part parameters (see
C             the description of the argument XINIT of SLICOT Library
C             routine MD03BD); this enables to obtain reproducible
C             results. The same seed is used for all outputs.
C             On exit, if INFO = 0, DWORK(1) returns the optimal value
C             of LDWORK, DWORK(2) returns the residual error norm (the
C             sum of squares), DWORK(3) returns the number of iterations
C             performed, and DWORK(4) returns the final Levenberg
C             factor, for optimizing the parameters of both the linear
C             part and the static nonlinearity part. If INIT = 'S' or
C             INIT = 'B' and INFO = 0, then the elements DWORK(5) to
C             DWORK(8) contain the corresponding four values for the
C             initialization step (see METHOD). (If L > 1, DWORK(8)
C             contains the maximum of the Levenberg factors for all
C             outputs.) If INIT = 'L' or INIT = 'B', and INFO = 0,
C             DWORK(9) to DWORK(8+IWORK(3)) contain reciprocal condition
C             number estimates set by SLICOT Library routines IB01AD,
C             IB01BD, and IB01CD.
C             On exit, if  INFO = -21,  DWORK(1)  returns the minimum
C             value of LDWORK.
C
C     LDWORK  INTEGER
C             The length of the array DWORK.
C             In the formulas below, N should be taken not larger than
C             NOBR - 1, if N < 0 on entry.
C             LDWORK = MAX( LW1, LW2, LW3, LW4 ), where
C             LW1 = 0, if INIT = 'S' or 'N'; otherwise,
C             LW1 = MAX( 2*(M+L)*NOBR*(2*(M+L)*(NOBR+1)+3) + L*NOBR,
C                        4*(M+L)*NOBR*(M+L)*NOBR + (N+L)*(N+M) +
C                        MAX( LDW1, LDW2 ),
C                        (N+L)*(N+M) + N + N*N + 2 + N*(N+M+L) +
C                        MAX( 5*N, 2, MIN( LDW3, LDW4 ), LDW5, LDW6 ),
C                 where,
C                 LDW1 >= MAX( 2*(L*NOBR-L)*N+2*N, (L*NOBR-L)*N+N*N+7*N,
C                              L*NOBR*N +
C                              MAX( (L*NOBR-L)*N+2*N + (2*M+L)*NOBR+L,
C                                   2*(L*NOBR-L)*N+N*N+8*N,
C                                   N+4*(M*NOBR+N)+1, M*NOBR+3*N+L ) )
C                 LDW2 >= 0,                                  if M = 0;
C                 LDW2 >= L*NOBR*N + M*NOBR*(N+L)*(M*(N+L)+1) +
C                         MAX( (N+L)**2, 4*M*(N+L)+1 ),       if M > 0;
C                 LDW3 = NSMP*L*(N+1) + 2*N + MAX( 2*N*N, 4*N ),
C                 LDW4 = N*(N+1) + 2*N +
C                        MAX( N*L*(N+1) + 2*N*N + L*N, 4*N );
C                 LDW5 = NSMP*L + (N+L)*(N+M) + 3*N+M+L;
C                 LDW6 = NSMP*L + (N+L)*(N+M) + N +
C                        MAX(1, N*N*L + N*L + N, N*N +
C                            MAX(N*N + N*MAX(N,L) + 6*N + MIN(N,L),
C                                N*M));
C             LW2 = LW3 = 0, if INIT = 'L' or 'N'; otherwise,
C             LW2 = NSMP*L + BSN +
C                   MAX( 4, NSMP +
C                           MAX( NSMP*BSN + MAX( 2*NN, 5*BSN + 1 ),
C                                BSN**2 + BSN +
C                                MAX( NSMP + 2*NN, 5*BSN ) ) );
C             LW3 = MAX( LDW7, NSMP*L + (N+L)*(2*N+M) + 2*N );
C                 LDW7 = NSMP*L + (N+L)*(N+M) + 3*N+M+L,  if M > 0;
C                 LDW7 = NSMP*L + (N+L)*N + 2*N+L,        if M = 0;
C             LW4 = NSMP*L + NX +
C                   MAX( 4, NSMP*L +
C                           MAX( NSMP*L*( BSN + LTHS ) +
C                                MAX( NSMP*L + L1, L2 + NX ),
C                                     NX*( BSN + LTHS ) + NX +
C                                     MAX( NSMP*L + L1, NX + L3 ) ) ),
C                  L0 = MAX( N*(N+L), N+M+L ),    if M > 0;
C                  L0 = MAX( N*(N+L), L ),        if M = 0;
C                  L1 = NSMP*L + MAX( 2*NN, (N+L)*(N+M) + 2*N + L0);
C                  L2 = 4*NX + 1,  if L <= 1 or BSN = 0; otherwise,
C                  L2 = BSN + MAX(3*BSN+1,LTHS);
C                  L2 = MAX(L2,4*LTHS+1),         if NSMP > BSN;
C                  L2 = MAX(L2,(NSMP-BSN)*(L-1)), if BSN < NSMP < 2*BSN;
C                  L3 = 4*NX,                     if L <= 1 or BSN = 0;
C                  L3 = LTHS*BSN + 2*NX + 2*MAX(BSN,LTHS),
C                                                 if L > 1 and BSN > 0,
C                  with BSN  = NN*( L + 2 ) + 1,
C                       LTHS = N*( L + M + 1 ) + L*M.
C             For optimum performance LDWORK should be larger.
C
C     Warning Indicator
C
C     IWARN   INTEGER
C             < 0:  the user set IFLAG = IWARN in (one of) the
C                   subroutine(s) FCN, i.e., NF01BE, if INIT = 'S'
C                   or 'B', and/or NF01BF; this value cannot be returned
C                   without changing the FCN routine(s);
C                   otherwise, IWARN has the value k*100 + j*10 + i,
C                   where k is defined below, i refers to the whole
C                   optimization process, and j refers to the
C                   initialization step (j = 0, if INIT = 'L' or 'N'),
C                   and the possible values for i and j have the
C                   following meaning (where TOL* denotes TOL1 or TOL2,
C                   and similarly for ITMAX*):
C             = 1:  both actual and predicted relative reductions in
C                   the sum of squares are at most TOL*;
C             = 2:  relative error between two consecutive iterates is
C                   at most TOL*;
C             = 3:  conditions for i or j = 1 and i or j = 2 both hold;
C             = 4:  the cosine of the angle between the vector of error
C                   function values and any column of the Jacobian is at
C                   most EPS in absolute value;
C             = 5:  the number of iterations has reached ITMAX* without
C                   satisfying any convergence condition;
C             = 6:  TOL* is too small: no further reduction in the sum
C                   of squares is possible;
C             = 7:  TOL* is too small: no further improvement in the
C                   approximate solution X is possible;
C             = 8:  the vector of function values e is orthogonal to the
C                   columns of the Jacobian to machine precision.
C             The digit k is normally 0, but if INIT = 'L' or 'B', it
C             can have a value in the range 1 to 6 (see IB01AD, IB01BD
C             and IB01CD). In all these cases, the entries DWORK(1:4),
C             DWORK(5:8) (if INIT = 'S' or 'B'), and DWORK(9:8+IWORK(3))
C             (if INIT = 'L' or 'B'), are set as described above.
C
C     Error Indicator
C
C     INFO    INTEGER
C             = 0:  successful exit;
C             < 0:  if INFO = -i, the i-th argument had an illegal
C                   value;
C                   otherwise, INFO has the value k*100 + j*10 + i,
C                   where k is defined below, i refers to the whole
C                   optimization process, and j refers to the
C                   initialization step (j = 0, if INIT = 'L' or 'N'),
C                   and the possible values for i and j have the
C                   following meaning:
C             = 1:  the routine FCN returned with INFO <> 0 for
C                   IFLAG = 1;
C             = 2:  the routine FCN returned with INFO <> 0 for
C                   IFLAG = 2;
C             = 3:  the routine QRFACT returned with INFO <> 0;
C             = 4:  the routine LMPARM returned with INFO <> 0.
C             In addition, if INIT = 'L' or 'B', i could also be
C             = 5:  if a Lyapunov equation could not be solved;
C             = 6:  if the identified linear system is unstable;
C             = 7:  if the QR algorithm failed on the state matrix
C                   of the identified linear system.
C             QRFACT and LMPARM are generic names for SLICOT Library
C             routines NF01BS and NF01BP, respectively, for the whole
C             optimization process, and MD03BA and MD03BB, respectively,
C             for the initialization step (if INIT = 'S' or 'B').
C             The digit k is normally 0, but if INIT = 'L' or 'B', it
C             can have a value in the range 1 to 10 (see IB01AD/IB01BD).
C
C     METHOD
C
C     If INIT = 'L' or 'B', the linear part of the system is
C     approximated using the combined MOESP and N4SID algorithm. If
C     necessary, this algorithm can also choose the order, but it is
C     advantageous if the order is already known.
C
C     If INIT = 'S' or 'B', the output of the approximated linear part
C     is computed and used to calculate an approximation of the static
C     nonlinearity using the Levenberg-Marquardt algorithm [1,3].
C     This step is referred to as the (nonlinear) initialization step.
C
C     As last step, the Levenberg-Marquardt algorithm is used again to
C     optimize the parameters of the linear part and the static
C     nonlinearity as a whole. Therefore, it is necessary to parametrise
C     the matrices of the linear part. The output normal form [2]
C     parameterisation is used.
C
C     The Jacobian is computed analytically, for the nonlinear part, and
C     numerically, for the linear part.
C
C     REFERENCES
C
C     [1] More, J.J., Garbow, B.S, and Hillstrom, K.E.
C         User's Guide for MINPACK-1.
C         Applied Math. Division, Argonne National Laboratory, Argonne,
C         Illinois, Report ANL-80-74, 1980.
C
C     [2] Peeters, R.L.M., Hanzon, B., and Olivi, M.
C         Balanced realizations of discrete-time stable all-pass
C         systems and the tangential Schur algorithm.
C         Proceedings of the European Control Conference,
C         31 August - 3 September 1999, Karlsruhe, Germany.
C         Session CP-6, Discrete-time Systems, 1999.
C
C     [3] More, J.J.
C         The Levenberg-Marquardt algorithm: implementation and theory.
C         In Watson, G.A. (Ed.), Numerical Analysis, Lecture Notes in
C         Mathematics, vol. 630, Springer-Verlag, Berlin, Heidelberg
C         and New York, pp. 105-116, 1978.
C
C     NUMERICAL ASPECTS
C
C     The Levenberg-Marquardt algorithm described in [3] is scaling
C     invariant and globally convergent to (maybe local) minima.
C     The convergence rate near a local minimum is quadratic, if the
C     Jacobian is computed analytically, and linear, if the Jacobian
C     is computed numerically.
C
C     CONTRIBUTORS
C
C     V. Sima, Research Institute for Informatics, Bucharest, Dec. 2001.
C
C     REVISIONS
C
C     V. Sima, March, 2002, Apr. 2002, Feb. 2004, March 2005.
C
C     KEYWORDS
C
C     Least-squares approximation, Levenberg-Marquardt algorithm,
C     matrix operations, optimization.
C
C     ******************************************************************
C
C     .. Parameters ..
      DOUBLE PRECISION  ZERO
      PARAMETER         ( ZERO = 0.0D0 )
C     FACTOR is a scaling factor for variables (see MD03BD).
      DOUBLE PRECISION  FACTOR
      PARAMETER         ( FACTOR = 100.0D0 )
C     Condition estimation and internal scaling of variables are used
C     (see MD03BD).
      CHARACTER         COND, SCALE
      PARAMETER         ( COND = 'E', SCALE = 'I' )
C     Default tolerances are used in MD03BD for measuring the
C     orthogonality between the vector of function values and columns
C     of the Jacobian (GTOL), and for the rank estimations (TOL).
      DOUBLE PRECISION  GTOL, TOL
      PARAMETER         ( GTOL = 0.0D0, TOL = 0.0D0 )
C     For INIT = 'L' or 'B', additional parameters are set:
C     The following six parameters are used in the call of IB01AD;
      CHARACTER         ALG, BATCH, CONCT, CTRL, JOBD, METH
      PARAMETER         ( ALG   = 'Fast QR',     BATCH = 'One batch',
     $                    CONCT = 'Not connect', CTRL  = 'Not confirm',
     $                    JOBD  = 'Not MOESP',   METH  = 'MOESP' )
C     The following three parameters are used in the call of IB01BD;
      CHARACTER         JOB, JOBCK, METHB
      PARAMETER         ( JOB   = 'All matrices',
     $                    JOBCK = 'No Kalman gain',
     $                    METHB = 'Combined MOESP+N4SID' )
C     The following two parameters are used in the call of IB01CD;
      CHARACTER         COMUSE, JOBXD
      PARAMETER         ( COMUSE = 'Use B, D',
     $                    JOBXD  = 'D also' )
C     TOLN controls the estimated order in IB01AD (default value);
      DOUBLE PRECISION  TOLN
      PARAMETER         ( TOLN = -1.0D0 )
C     RCOND controls the rank decisions in IB01AD, IB01BD, and IB01CD
C     (default);
      DOUBLE PRECISION  RCOND
      PARAMETER         ( RCOND = -1.0D0 )
C     .. Scalar Arguments ..
      CHARACTER         INIT
      INTEGER           INFO, ITMAX1, ITMAX2, IWARN, L, LDU, LDWORK,
     $                  LDY, LX, M, N, NN, NOBR, NPRINT, NSMP
      DOUBLE PRECISION  TOL1, TOL2
C     .. Array Arguments ..
      DOUBLE PRECISION  DWORK(*), U(LDU, *), X(*), Y(LDY, *)
      INTEGER           IWORK(*)
C     .. Local Scalars ..
      INTEGER           AC, BD, BSN, I, IA, IB, IDIAG, IK, INFOL, IQ,
     $                  IR, IRCND, IRCNDB, IRY, IS, ISAD, ISV, IV, IW1,
     $                  IW2, IW3, IWARNL, IX, IX0, J, JWORK, LDAC, LDR,
     $                  LIPAR, LNOL, LTHS, ML, MNO, N2, NFEV, NJEV, NS,
     $                  NSML, NTHS, NX, WRKOPT, Z
      LOGICAL           INIT1, INIT2
C     .. Local Arrays ..
      LOGICAL           BWORK(1)
      INTEGER           IPAR(7)
      DOUBLE PRECISION  RCND(16), SEED(4), WORK(4)
C     .. External Functions ..
      EXTERNAL          LSAME
      LOGICAL           LSAME
C     .. External Subroutines ..
      EXTERNAL          DCOPY,  IB01AD, IB01BD, IB01CD, MD03BA, MD03BB,
     $                  MD03BD, NF01BE, NF01BF, NF01BP, NF01BS, TB01VD,
     $                  TB01VY, TF01MX, XERBLA
C     .. Intrinsic Functions ..
      INTRINSIC         INT, MAX, MIN
C     ..
C     .. Executable Statements ..
C
C     Check the scalar input parameters.
C
      INIT1 = LSAME( INIT, 'B' ) .OR. LSAME( INIT, 'L' )
      INIT2 = LSAME( INIT, 'B' ) .OR. LSAME( INIT, 'S' )
C
      ML    = M + L
      INFO  = 0
      IWARN = 0
      IF ( .NOT.( INIT1 .OR. INIT2 .OR. LSAME( INIT, 'N' ) ) ) THEN
         INFO = -1
      ELSEIF ( INIT1 .AND. NOBR.LE.0 ) THEN
         INFO = -2
      ELSEIF ( M.LT.0 ) THEN
         INFO = -3
      ELSEIF ( L.LT.0 .OR. ( INIT1 .AND. L.EQ.0 ) ) THEN
         INFO = -4
      ELSEIF ( NSMP.LT.0 .OR.
     $         ( INIT1 .AND. NSMP.LT.2*( ML + 1 )*NOBR - 1 ) ) THEN
         INFO = -5
      ELSEIF ( ( N.LT.0 .AND. .NOT.INIT1 ) .OR.
     $       ( ( N.EQ.0 .OR. N.GE.NOBR ) .AND. INIT1 ) ) THEN
         INFO = -6
      ELSEIF ( NN.LT.0 ) THEN
         INFO = -7
      ELSEIF ( INIT2 .AND. ( ITMAX1.LT.0 ) ) THEN
         INFO = -8
      ELSEIF ( ITMAX2.LT.0 ) THEN
         INFO = -9
      ELSEIF ( LDU.LT.MAX( 1, NSMP ) ) THEN
         INFO = -12
      ELSEIF ( LDY.LT.MAX( 1, NSMP ) ) THEN
         INFO = -14
      ELSE
         LNOL = L*NOBR - L
         MNO  = M*NOBR
         BSN  = NN*( L + 2 ) + 1
         NTHS =  BSN*L
         NSML = NSMP*L
         IF ( N.GT.0 ) THEN
            LDAC = N + L
            ISAD = LDAC*( N + M )
            N2   = N*N
         END IF
C
C        Check the workspace size.
C
         JWORK = 0
         IF ( INIT1 ) THEN
C           Workspace for IB01AD.
            JWORK = 2*ML*NOBR*( 2*ML*( NOBR + 1 ) + 3 ) + L*NOBR
            IF ( N.GT.0 ) THEN
C              Workspace for IB01BD.
               IW1 = MAX( 2*LNOL*N + 2*N, LNOL*N + N2 + 7*N, L*NOBR*N +
     $                    MAX( LNOL*N + 2*N + ( M + ML )*NOBR + L,
     $                         2*LNOL*N + N2 + 8*N, N + 4*( MNO + N ) +
     $                         1, MNO + 3*N + L ) )
               IF ( M.GT.0 ) THEN
                  IW2 = L*NOBR*N + MNO*LDAC*( M*LDAC + 1 ) +
     $                  MAX( LDAC**2, 4*M*LDAC + 1 )
               ELSE
                  IW2 = 0
               END IF
               JWORK = MAX( JWORK,
     $                      ( 2*ML*NOBR )**2 + ISAD + MAX( IW1, IW2 ) )
C              Workspace for IB01CD.
               IW1   = NSML*( N + 1 ) + 2*N + MAX( 2*N2, 4*N )
               IW2   = N*( N + 1 ) + 2*N +
     $                 MAX( N*L*( N + 1 ) + 2*N2 + L*N, 4*N )
               JWORK = MAX( JWORK, ISAD + 2 + N*( N + 1 + LDAC + M ) +
     $                     MAX( 5*N, 2, MIN( IW1, IW2 ) ) )
C              Workspace for TF01MX.
               JWORK = MAX( JWORK, NSML + ISAD + LDAC + 2*N + M )
C              Workspace for TB01VD.
               JWORK = MAX( JWORK, NSML + ISAD + N +
     $                      MAX( 1, N2*L + N*L + N,
     $                           N2 + MAX( N2 + N*MAX( N, L ) +
     $                                     6*N +  MIN( N, L ), N*M ) ) )
            END IF
         END IF
C
         IF ( INIT2 ) THEN
C           Workspace for MD03BD (initialization of the nonlinear part).
            JWORK = MAX( JWORK, NSML + BSN +
     $                   MAX( 4, NSMP +
     $                        MAX( NSMP*BSN + MAX( 2*NN, 5*BSN + 1 ),
     $                             BSN**2 + BSN +
     $                             MAX( NSMP + 2*NN, 5*BSN ) ) ) )
            IF ( N.GT.0 .AND. .NOT.INIT1 ) THEN
C              Workspace for TB01VY.
               JWORK = MAX( JWORK, NSML + LDAC*( 2*N + M ) + 2*N )
C              Workspace for TF01MX.
               IF ( M.GT.0 ) THEN
                  IW1 = N + M
               ELSE
                  IW1 = 0
               END IF
               JWORK = MAX( JWORK, NSML + ISAD + IW1 + LDAC + N )
            END IF
         END IF
C
         IF ( N.GE.0 ) THEN
C
C           Find the number of parameters.
C
            LTHS = N*( ML + 1 ) + L*M
            NX   = NTHS + LTHS
C
            IF ( LX.LT.NX ) THEN
               INFO = -16
               CALL XERBLA( 'IB03BD', -INFO )
               RETURN
            END IF
C
C           Workspace for MD03BD (whole optimization).
C
            IF ( M.GT.0 ) THEN
               IW1 = LDAC + M
            ELSE
               IW1 = L
            END IF
            IW1 = NSML + MAX( 2*NN, ISAD + 2*N + MAX( N*LDAC, IW1 ) )
            IF ( L.LE.1 .OR. BSN.EQ.0 ) THEN
               IW3 = 4*NX
               IW2 = IW3 + 1
            ELSE
               IW2 = BSN + MAX( 3*BSN + 1, LTHS )
               IF ( NSMP.GT.BSN ) THEN
                  IW2 = MAX( IW2, 4*LTHS + 1 )
                  IF ( NSMP.LT.2*BSN )
     $               IW2 = MAX( IW2, ( NSMP - BSN )*( L - 1 ) )
               END IF
               IW3 = LTHS*BSN + 2*NX + 2*MAX( BSN, LTHS )
            END IF
            JWORK = MAX( JWORK, NSML + NX +
     $                   MAX( 4, NSML +
     $                           MAX( NSML*( BSN + LTHS ) +
     $                                MAX( NSML + IW1, IW2 + NX ),
     $                                     NX*( BSN + LTHS ) + NX +
     $                                     MAX( NSML + IW1, NX + IW3 ) )
     $                      ) )
         END IF
C
         IF ( LDWORK.LT.JWORK ) THEN
            INFO = -21
            DWORK(1) = JWORK
         END IF
      END IF
C
      IF( INFO.NE.0 ) THEN
         CALL XERBLA( 'IB03BD', -INFO )
         RETURN
      END IF
C
C     Initialize the pointers to system matrices and save the possible
C     seed for random numbers generation.
C
      Z  = 1
      AC = Z + NSML
      CALL DCOPY( 4, DWORK, 1, SEED, 1 )
C
      WRKOPT = 1
C
      IF ( INIT1 ) THEN
C
C        Initialize the linear part.
C        If N < 0, the order of the system is determined by IB01AD;
C        otherwise, the given order will be used.
C        The workspace needed is defined for the options set above
C        in the PARAMETER statements.
C        Workspace:  need:   2*(M+L)*NOBR*(2*(M+L)*(NOBR+1)+3) + L*NOBR;
C                    prefer: larger.
C        Integer workspace:  M+L. (If METH = 'N', (M+L)*NOBR.)
C
         NS  = N
         IR  = 1
         ISV = 2*ML*NOBR
         LDR = ISV
         IF ( LSAME( JOBD, 'M' ) )
     $      LDR = MAX( LDR, 3*MNO )
         ISV   = IR  + LDR*ISV
         JWORK = ISV + L*NOBR
C
         CALL IB01AD( METH, ALG, JOBD, BATCH, CONCT, CTRL, NOBR, M, L,
     $                NSMP, U, LDU, Y, LDY, N, DWORK(IR), LDR,
     $                DWORK(ISV), RCOND, TOLN, IWORK, DWORK(JWORK),
     $                LDWORK-JWORK+1, IWARNL, INFOL )
C
         IF( INFOL.NE.0 ) THEN
            INFO = 100*INFOL
            RETURN
         END IF
         IF( IWARNL.NE.0 )
     $      IWARN = 100*IWARNL
         WRKOPT = MAX( WRKOPT, INT( DWORK(JWORK) ) + JWORK - 1 )
         IRCND  = 0
         IF ( LSAME( METH, 'N' ) ) THEN
            IRCND = 2
            CALL DCOPY( IRCND, DWORK(JWORK+1), 1, RCND, 1 )
         END IF
C
         IF ( NS.GE.0 ) THEN
            N = NS
         ELSE
C
C           Find the number of parameters.
C
            LDAC = N + L
            ISAD = LDAC*( N + M )
            N2   = N*N
            LTHS = N*( ML + 1 ) + L*M
            NX   = NTHS + LTHS
C
            IF ( LX.LT.NX ) THEN
               LX   = NX
               INFO = -16
               CALL XERBLA( 'IB03BD', -INFO )
               RETURN
            END IF
C           Workspace for IB01BD.
            IW1 = MAX( 2*LNOL*N + 2*N, LNOL*N + N2 + 7*N, L*NOBR*N +
     $                 MAX( LNOL*N + 2*N + ( M + ML )*NOBR + L,
     $                      2*LNOL*N + N2 + 8*N, N + 4*( MNO + N ) + 1,
     $                      MNO + 3*N + L ) )
            IF ( M.GT.0 ) THEN
               IW2 = L*NOBR*N + MNO*LDAC*( M*LDAC + 1 ) +
     $               MAX( LDAC**2, 4*M*LDAC + 1 )
            ELSE
               IW2 = 0
            END IF
            JWORK = ISV + ISAD + MAX( IW1, IW2 )
C           Workspace for IB01CD.
            IW1   = NSML*( N + 1 ) + 2*N + MAX( 2*N2, 4*N )
            IW2   = N*( N + 1 ) + 2*N + MAX( N*L*( N + 1 ) + 2*N2 + L*N,
     $                                       4*N )
            JWORK = MAX( JWORK, ISAD + 2 + N*( N + 1 + LDAC + M ) +
     $                   MAX( 5*N, 2, MIN( IW1, IW2 ) ) )
C           Workspace for TF01MX.
            JWORK = MAX( JWORK, NSML + ISAD + LDAC + 2*N + M )
C           Workspace for TB01VD.
            JWORK = MAX( JWORK, NSML + ISAD + N +
     $                   MAX( 1, N2*L + N*L + N,
     $                        N2 + MAX( N2 + N*MAX( N, L ) +
     $                                  6*N +  MIN( N, L ), N*M ) ) )
C           Workspace for MD03BD (whole optimization).
            IF ( M.GT.0 ) THEN
               IW1 = LDAC + M
            ELSE
               IW1 = L
            END IF
            IW1 = NSML + MAX( 2*NN, ISAD + 2*N + MAX( N*LDAC, IW1 ) )
            IF ( L.LE.1 .OR. BSN.EQ.0 ) THEN
               IW3 = 4*NX
               IW2 = IW3 + 1
            ELSE
               IW2 = BSN + MAX( 3*BSN + 1, LTHS )
               IF ( NSMP.GT.BSN ) THEN
                  IW2 = MAX( IW2, 4*LTHS + 1 )
                  IF ( NSMP.LT.2*BSN )
     $               IW2 = MAX( IW2, ( NSMP - BSN )*( L - 1 ) )
               END IF
               IW3 = LTHS*BSN + 2*NX + 2*MAX( BSN, LTHS )
            END IF
            JWORK = MAX( JWORK, NSML + NX +
     $                   MAX( 4, NSML +
     $                           MAX( NSML*( BSN + LTHS ) +
     $                                MAX( NSML + IW1, IW2 + NX ),
     $                                     NX*( BSN + LTHS ) + NX +
     $                                     MAX( NSML + IW1, NX + IW3 ) )
     $                      ) )
            IF ( LDWORK.LT.JWORK ) THEN
               INFO = -21
               DWORK(1) = JWORK
               CALL XERBLA( 'IB03BD', -INFO )
               RETURN
            END IF
         END IF
C
         BD = AC + LDAC*N
         IX = BD + LDAC*M
         IA = ISV
         IB = IA + LDAC*N
         IQ = IB + LDAC*M
         IF ( LSAME( JOBCK, 'N' ) ) THEN
            IRY   = IQ
            IS    = IQ
            IK    = IQ
            JWORK = IQ
         ELSE
            IRY   = IQ  + N2
            IS    = IRY + L*L
            IK    = IS  + N*L
            JWORK = IK  + N*L
         END IF
C
C        The workspace needed is defined for the options set above
C        in the PARAMETER statements.
C        Workspace:
C          need:  4*(M+L)*NOBR*(M+L)*NOBR + (N+L)*(N+M) +
C                 max( LDW1,LDW2 ), where,
C                 LDW1 >= max( 2*(L*NOBR-L)*N+2*N, (L*NOBR-L)*N+N*N+7*N,
C                              L*NOBR*N +
C                              max( (L*NOBR-L)*N+2*N + (2*M+L)*NOBR+L,
C                                   2*(L*NOBR-L)*N+N*N+8*N,
C                                   N+4*(M*NOBR+N)+1, M*NOBR+3*N+L ) )
C                 LDW2 >= 0,                                  if M = 0;
C                 LDW2 >= L*NOBR*N+M*NOBR*(N+L)*(M*(N+L)+1)+
C                         max( (N+L)**2, 4*M*(N+L)+1 ),       if M > 0;
C          prefer: larger.
C        Integer workspace:  MAX(M*NOBR+N,M*(N+L)).
C
         CALL IB01BD( METHB, JOB, JOBCK, NOBR, N, M, L, NSMP, DWORK(IR),
     $                LDR, DWORK(IA), LDAC, DWORK(IA+N), LDAC,
     $                DWORK(IB), LDAC, DWORK(IB+N), LDAC, DWORK(IQ), N,
     $                DWORK(IRY), L, DWORK(IS), N, DWORK(IK), N, RCOND,
     $                IWORK, DWORK(JWORK), LDWORK-JWORK+1, BWORK,
     $                IWARNL, INFOL )
C
         IF( INFOL.EQ.-30 ) THEN
            INFO = -21
            DWORK(1) = DWORK(JWORK)
            CALL XERBLA( 'IB03BD', -INFO )
            RETURN
         END IF
         IF( INFOL.NE.0 ) THEN
            INFO = 100*INFOL
            RETURN
         END IF
         IF( IWARNL.NE.0 )
     $      IWARN = 100*IWARNL
         WRKOPT = MAX( WRKOPT, INT( DWORK(JWORK) ) + JWORK - 1 )
         IRCNDB = 4
         IF ( LSAME( JOBCK, 'K' ) )
     $      IRCNDB = IRCNDB + 8
         CALL DCOPY( IRCNDB, DWORK(JWORK+1), 1, RCND(IRCND+1), 1 )
         IRCND = IRCND + IRCNDB
C
C        Copy the system matrices to the beginning of DWORK, to save
C        space, and redefine the pointers.
C
         CALL DCOPY( ISAD, DWORK(IA), 1, DWORK, 1 )
         IA  = 1
         IB  = IA  + LDAC*N
         IX0 = IB  + LDAC*M
         IV  = IX0 + N
C
C        Compute the initial condition of the system. On normal exit,
C           DWORK(i), i = JWORK+2:JWORK+1+N*N,
C           DWORK(j), j = JWORK+2+N*N:JWORK+1+N*N+L*N,  and
C           DWORK(k), k = JWORK+2+N*N+L*N:JWORK+1+N*N+L*N+N*M,
C        contain the transformed system matrices  At, Ct, and Bt,
C        respectively, corresponding to the real Schur form of the
C        estimated system state matrix  A. The transformation matrix is
C        stored in DWORK(IV:IV+N*N-1).
C        The workspace needed is defined for the options set above
C        in the PARAMETER statements.
C        Workspace:
C          need:   (N+L)*(N+M) + N + N*N + 2 + N*( N + M + L ) +
C                  max( 5*N, 2, min( LDW1, LDW2 ) ), where,
C                  LDW1 = NSMP*L*(N + 1) + 2*N + max( 2*N*N, 4*N),
C                  LDW2 = N*(N + 1) + 2*N +
C                         max( N*L*(N + 1) + 2*N*N + L*N, 4*N);
C          prefer: larger.
C        Integer workspace:  N.
C
         JWORK = IV + N2
         CALL IB01CD( 'X needed', COMUSE, JOBXD, N, M, L, NSMP,
     $                DWORK(IA), LDAC, DWORK(IB), LDAC, DWORK(IA+N),
     $                LDAC, DWORK(IB+N), LDAC, U, LDU, Y, LDY,
     $                DWORK(IX0), DWORK(IV), N, RCOND, IWORK,
     $                DWORK(JWORK), LDWORK-JWORK+1, IWARNL, INFOL )
C
         IF( INFOL.EQ.-26 ) THEN
            INFO = -21
            DWORK(1) = DWORK(JWORK)
            CALL XERBLA( 'IB03BD', -INFO )
            RETURN
         END IF
         IF( INFOL.EQ.1 )
     $      INFOL = 10
         IF( INFOL.NE.0 ) THEN
            INFO = 100*INFOL
            RETURN
         END IF
         IF( IWARNL.NE.0 )
     $      IWARN = 100*IWARNL
         WRKOPT = MAX( WRKOPT, INT( DWORK(JWORK) ) + JWORK - 1 )
         IRCND  = IRCND + 1
         RCND(IRCND) = DWORK(JWORK+1)
C
C        Now, save the system matrices and x0 in the final location.
C
         IF ( IV.LT.AC ) THEN
            CALL DCOPY( ISAD+N, DWORK(IA), 1, DWORK(AC), 1 )
         ELSE
            DO 10 J = AC + ISAD + N - 1, AC, -1
               DWORK(J) = DWORK(IA+J-AC)
   10       CONTINUE
         END IF
C
C        Compute the output of the linear part.
C        Workspace: need   NSMP*L + (N + L)*(N + M) + 3*N + M + L,
C                                                              if M > 0;
C                          NSMP*L + (N + L)*N + 2*N + L,       if M = 0;
C                   prefer larger.
C
         JWORK = IX + N
         CALL DCOPY(  N, DWORK(IX), 1, X(NTHS+1), 1 )
         CALL TF01MX( N, M, L, NSMP, DWORK(AC), LDAC, U, LDU, X(NTHS+1),
     $                DWORK(Z), NSMP, DWORK(JWORK), LDWORK-JWORK+1,
     $                INFO )
C
C        Convert the state-space representation to output normal form.
C        Workspace:
C          need:   NSMP*L + (N + L)*(N + M) + N +
C                  MAX(1, N*N*L + N*L + N, N*N +
C                      MAX(N*N + N*MAX(N,L) + 6*N + MIN(N,L), N*M));
C          prefer: larger.
C
         CALL TB01VD( 'Apply', N, M, L, DWORK(AC), LDAC, DWORK(BD),
     $                LDAC, DWORK(AC+N), LDAC, DWORK(BD+N), LDAC,
     $                DWORK(IX), X(NTHS+1), LTHS, DWORK(JWORK),
     $                LDWORK-JWORK+1, INFOL )
C
         IF( INFOL.GT.0 ) THEN
            INFO = INFOL + 4
            RETURN
         END IF
         WRKOPT = MAX( WRKOPT, INT( DWORK(JWORK) ) + JWORK - 1 )
C
      END IF
C
      LIPAR = 7
      IW1   = 0
      IW2   = 0
      IDIAG = AC
C
      IF ( INIT2 ) THEN
C
C        Initialize the nonlinear part.
C
         IF ( .NOT.INIT1 ) THEN
            BD = AC + LDAC*N
            IX = BD + LDAC*M
C
C           Convert the output normal form to state-space model.
C           Workspace: need NSMP*L + (N + L)*(2*N + M) + 2*N.
C           (NSMP*L locations are reserved for the output of the linear
C           part.)
C
            JWORK = IX + N
            CALL TB01VY( 'Apply', N, M, L, X(NTHS+1), LTHS, DWORK(AC),
     $                   LDAC, DWORK(BD), LDAC, DWORK(AC+N), LDAC,
     $                   DWORK(BD+N), LDAC, DWORK(IX), DWORK(JWORK),
     $                   LDWORK-JWORK+1, INFO )
C
C           Compute the output of the linear part.
C           Workspace: need   NSMP*L + (N + L)*(N + M) + 3*N + M + L,
C                                                              if M > 0;
C                             NSMP*L + (N + L)*N + 2*N + L,    if M = 0;
C                      prefer larger.
C
            CALL TF01MX( N, M, L, NSMP, DWORK(AC), LDAC, U, LDU,
     $                   DWORK(IX), DWORK(Z), NSMP, DWORK(JWORK),
     $                   LDWORK-JWORK+1, INFO )
         END IF
C
C        Optimize the parameters of the nonlinear part.
C        Workspace:
C          need   NSMP*L + BSN +
C                 MAX( 4, NSMP +
C                      MAX( NSMP*BSN + MAX( 2*NN, 5*BSN + 1 ),
C                           BSN**2 + BSN + MAX( NSMP + 2*NN, 5*BSN ) ));
C          prefer larger.
C        Integer workspace:  NN*(L + 2) + 2.
C
         WORK(1) = ZERO
         CALL DCOPY( 3, WORK(1), 0, WORK(2), 1 )
C
C        Set the integer parameters needed, including the number of
C        neurons.
C
         IPAR(1) = NSMP
         IPAR(2) = L
         IPAR(3) = NN
         JWORK   = IDIAG + BSN
C
         DO 30 I = 0, L - 1
            CALL DCOPY( 4, SEED, 1, DWORK(JWORK), 1 )
            CALL MD03BD( 'Random initialization', SCALE, COND, NF01BE,
     $                   MD03BA, MD03BB, NSMP, BSN, ITMAX1, FACTOR,
     $                   NPRINT, IPAR, LIPAR, DWORK(Z), NSMP, Y(1,I+1),
     $                   LDY, X(I*BSN+1), DWORK(IDIAG), NFEV, NJEV,
     $                   TOL1, TOL1, GTOL, TOL, IWORK, DWORK(JWORK),
     $                   LDWORK-JWORK+1, IWARNL, INFOL )
            IF( INFOL.NE.0 ) THEN
               INFO = 10*INFOL
               RETURN
            END IF
            IF ( IWARNL.LT.0 ) THEN
               INFO  = INFOL
               IWARN = IWARNL
               GO TO 50
            ELSEIF ( IWARNL.GT.0 ) THEN
               IF ( IWARN.GT.100 ) THEN
                  IWARN = MAX( IWARN, ( IWARN/100 )*100 + 10*IWARNL )
               ELSE
                  IWARN = MAX( IWARN, 10*IWARNL )
               END IF
            END IF
            WORK(1) = MAX( WORK(1), DWORK(JWORK) )
            WORK(2) = MAX( WORK(2), DWORK(JWORK+1) )
            WORK(4) = MAX( WORK(4), DWORK(JWORK+3) )
            WORK(3) = WORK(3) + DWORK(JWORK+2)
            IW1     = NFEV + IW1
            IW2     = NJEV + IW2
   30    CONTINUE
C
      END IF
C
C     Main iteration.
C     Workspace:
C       need   NSMP*L + NX +
C              MAX( 4, NSMP*L +
C                      MAX( NSMP*L*( BSN + LTHS ) +
C                           MAX( NSMP*L + LDW1, LDW2 + NX ),
C                                NX*( BSN + LTHS ) + NX +
C                                MAX( NSMP*L + LDW1, NX + LDW3 ) ) ),
C              LDW0 = MAX( N*(N+L), N+M+L ),    if M > 0;
C              LDW0 = MAX( N*(N+L), L ),        if M = 0;
C              LDW1 = NSMP*L + MAX( 2*NN, (N + L)*(N + M) + 2*N + LDW0);
C              LDW2 = 4*NX + 1,  if L <= 1 or BSN = 0; otherwise,
C              LDW2 = BSN + MAX(3*BSN+1,LTHS);
C              LDW2 = MAX(LDW2, 4*LTHS+1),        if NSMP > BSN;
C              LDW2 = MAX(LDW2, (NSMP-BSN)*(L-1)), if BSN < NSMP < 2*BSN;
C              LDW3 = 4*NX,                       if L <= 1 or BSN = 0;
C              LDW3 = LTHS*BSN + 2*NX + 2*MAX(BSN,LTHS),
C                                                 if L > 1 and BSN > 0;
C       prefer larger.
C     Integer workspace:  NX+L.
C
C     Set the integer parameters describing the Jacobian structure
C     and the number of neurons.
C
      IPAR(1) = LTHS
      IPAR(2) = L
      IPAR(3) = NSMP
      IPAR(4) = BSN
      IPAR(5) = M
      IPAR(6) = N
      IPAR(7) = NN
      JWORK   = IDIAG + NX
C
      CALL MD03BD( 'Given initialization', SCALE, COND, NF01BF,
     $             NF01BS, NF01BP, NSML, NX, ITMAX2, FACTOR, NPRINT,
     $             IPAR, LIPAR, U, LDU, Y, LDY, X, DWORK(IDIAG), NFEV,
     $             NJEV, TOL2, TOL2, GTOL, TOL, IWORK, DWORK(JWORK),
     $             LDWORK-JWORK+1, IWARNL, INFO )
      IF( INFO.NE.0 )
     $   RETURN
C
      DO 40 I = 1, NX + L
         IWORK(I+3) = IWORK(I)
   40 CONTINUE
C
   50 CONTINUE
      IWORK(1) = IW1 + NFEV
      IWORK(2) = IW2 + NJEV
      IF ( IWARNL.LT.0 ) THEN
         IWARN = IWARNL
      ELSE
         IWARN = IWARN + IWARNL
      END IF
      CALL DCOPY( 4, DWORK(JWORK), 1, DWORK, 1 )
      IF ( INIT2 )
     $   CALL DCOPY( 4, WORK, 1, DWORK(5), 1 )
      IF ( INIT1 ) THEN
         IWORK(3) = IRCND
         CALL DCOPY( IRCND, RCND, 1, DWORK(9), 1 )
      ELSE
         IWORK(3) = 0
      END IF
C
      RETURN
C
C *** Last line of IB03BD ***
      END
