C
C SPDX-License-Identifier: BSD-3-Clause
C
      SUBROUTINE NF01BA( IFLAG, NSMP, N, IPAR, LIPAR, Z, LDZ, Y, LDY, X,
     $                   NFEVL, E, J, LDJ, JTE, DWORK, LDWORK, INFO )
C
C     PURPOSE
C
C     This is the FCN routine for optimizing the parameters of the
C     nonlinear part of a Wiener system (initialization phase), using
C     SLICOT Library routine MD03AD. See the argument FCN in the
C     routine MD03AD for the description of parameters. Note that
C     NF01BA is called for each output of the Wiener system.
C
C     ******************************************************************
C
C     .. Parameters ..
C     .. CJTE is initialized to activate the calculation of J'*e ..
C     .. NOUT is the unit number for printing intermediate results ..
      CHARACTER         CJTE
      PARAMETER         ( CJTE = 'C' )
      INTEGER           NOUT
      PARAMETER         ( NOUT = 6 )
      DOUBLE PRECISION  ZERO, ONE
      PARAMETER         ( ZERO = 0.0D0, ONE = 1.0D0 )
C     .. Scalar Arguments ..
      INTEGER           IFLAG, INFO, LDJ, LDWORK, LDY, LDZ, LIPAR, N,
     $                  NFEVL, NSMP
C     .. Array Arguments ..
      INTEGER           IPAR(*)
      DOUBLE PRECISION  DWORK(*), E(*), J(LDJ,*), JTE(*), X(*),
     $                  Y(LDY,*), Z(LDZ,*)
C     .. Local Scalars ..
      DOUBLE PRECISION  ERR
C     .. External Functions ..
      DOUBLE PRECISION  DNRM2
      EXTERNAL          DNRM2
C     .. External Subroutines ..
      EXTERNAL          DAXPY, NF01AY, NF01BY
C
C     .. Executable Statements ..
C
      INFO = 0
      IF ( IFLAG.EQ.1 ) THEN
C
C        Call NF01AY to compute the output y of the Wiener system (in E)
C        and then the error functions (also in E). The array Z must
C        contain the output of the linear part of the Wiener system, and
C        Y must contain the original output Y of the Wiener system.
C        IPAR(2) must contain the number of outputs.
C        Workspace: need:    2*NN, NN = IPAR(3) (number of neurons);
C                   prefer:  larger.
C
         CALL NF01AY( NSMP, IPAR(2), 1, IPAR(3), LIPAR-2, X, N, Z, LDZ,
     $                E, NSMP, DWORK, LDWORK, INFO )
         CALL DAXPY( NSMP, -ONE, Y, 1, E, 1 )
         DWORK(1) = 2*IPAR(3)
C
      ELSE IF ( IFLAG.EQ.2 ) THEN
C
C        Call NF01BY to compute the Jacobian in a compressed form.
C        IPAR(2), IPAR(3) must have the same content as for IFLAG = 1.
C        Workspace: need:    0.
C
         CALL NF01BY( CJTE, NSMP, IPAR(2), 1, IPAR(3), LIPAR-2, X, N, Z,
     $                LDZ, E, J, LDJ, JTE, DWORK, LDWORK, INFO )
         NFEVL = 0
         DWORK(1) = ZERO
C
      ELSE IF ( IFLAG.EQ.3 ) THEN
C
C        Set the parameter LDJ, the length of the array J, and the sizes
C        of the workspace for FCN (IFLAG = 1 or 2), and JPJ.
C
         LDJ     = NSMP
         IPAR(1) = NSMP*N
         IPAR(2) = 2*IPAR(3)
         IPAR(3) = 0
         IPAR(4) = NSMP
C
      ELSE IF ( IFLAG.EQ.0 ) THEN
C
C        Special call for printing intermediate results.
C
         ERR = DNRM2( NSMP, E, 1 )
         WRITE( NOUT, '('' Norm of current error = '', D15.6)') ERR
      END IF
      RETURN
C
C *** Last line of NF01BA ***
      END
