NF01BX

Matrix-vector product x <-- (A' A + c I) x, for a full matrix A

[Specification] [Arguments] [Method] [References] [Comments] [Example]

Purpose

  To compute (J'*J + c*I)*x, where J is an m-by-n real matrix, c is
  a real scalar, I is the n-by-n identity matrix, and x is a real
  n-vector.

  NOTE: this routine must have the same arguments as SLICOT Library
  routine NF01BW. 

Specification
      SUBROUTINE NF01BX( N, IPAR, LIPAR, DPAR, LDPAR, J, LDJ, X, INCX,
     $                   DWORK, LDWORK, INFO )
C     .. Scalar Arguments ..
      INTEGER           INCX, INFO, LDJ, LDPAR, LDWORK, LIPAR, N
C     .. Array Arguments ..
      INTEGER           IPAR(*)
      DOUBLE PRECISION  DPAR(*), DWORK(*), J(LDJ,*), X(*)

Arguments

Input/Output Parameters

  N       (input) INTEGER
          The number of columns of the Jacobian matrix J.  N >= 0.

  IPAR    (input) INTEGER array, dimension (LIPAR)
          The integer parameters describing the structure of the 
          matrix J, as follows:
          IPAR(1) must contain the number of rows M of the Jacobian
                  matrix J.  M >= 0.
          IPAR is provided for compatibility with SLICOT Library 
          routine MD03AD.

  LIPAR   (input) INTEGER
          The length of the array IPAR.  LIPAR >= 1.

  DPAR    (input) DOUBLE PRECISION array, dimension (LDPAR)
          The real parameters needed for solving the problem.
          The entry DPAR(1) must contain the real scalar c.

  LDPAR   (input) INTEGER
          The length of the array DPAR.  LDPAR >= 1.

  J       (input) DOUBLE PRECISION array, dimension (LDJ,N)
          The leading M-by-N part of this array must contain the 
          Jacobian matrix J.

  LDJ     INTEGER
          The leading dimension of the array J.  LDJ >= MAX(1,M).

  X       (input/output) DOUBLE PRECISION array, dimension 
          (1+(N-1)*abs(INCX))
          On entry, this incremented array must contain the 
          vector x.
          On exit, this incremented array contains the value of the 
          matrix-vector product (J'*J + c*I)*x.

  INCX    (input) INTEGER
          The increment for the elements of X.  INCX <> 0.

Workspace
  DWORK   DOUBLE PRECISION array, dimension (LDWORK)

  LDWORK  INTEGER
          The length of the array DWORK.  LDWORK >= M.

Error Indicator
  INFO    INTEGER
          = 0:  successful exit;
          < 0:  if INFO = -i, the i-th argument had an illegal 
                value.

Method
  The associativity of matrix multiplications is used; the result
  is obtained as:  x_out = J'*( J*x ) + c*x.

Further Comments
  None
Example

Program Text

  None
Program Data
  None
Program Results
  None

Return to Supporting Routines index