SUBROUTINE NF01BE( IFLAG, NSMP, N, IPAR, LIPAR, Z, LDZ, Y, LDY, X,
$ NFEVL, E, J, LDJ, 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 MD03BD. See the argument FCN in the
C routine MD03BD for the description of parameters. Note that
C NF01BE is called for each output of the Wiener system.
C
C ******************************************************************
C
C .. Parameters ..
C .. CJTE is initialized to avoid the calculation of J'*e ..
C .. NOUT is the unit number for printing intermediate results ..
CHARACTER CJTE
PARAMETER ( CJTE = 'N' )
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,*), 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, DWORK, 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), QRFACT and LMPARM.
C
LDJ = NSMP
IPAR(1) = NSMP*N
IPAR(2) = 2*IPAR(3)
IPAR(3) = 0
IPAR(4) = 4*N + 1
IPAR(5) = 4*N
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 NF01BE ***
END