Previous: sptsv Up: ../lapack-s.html Next: spttrf


sptsvx


 NAME
      SPTSVX - use the factorization A = L*D*L**T to compute the
      solution to a real system of linear equations A*X = B, where
      A is an N-by-N symmetric positive definite tridiagonal
      matrix and X and B are N-by-NRHS matrices

 SYNOPSIS
      SUBROUTINE SPTSVX( FACT, N, NRHS, D, E, DF, EF, B, LDB, X,
                         LDX, RCOND, FERR, BERR, WORK, INFO )

          CHARACTER      FACT

          INTEGER        INFO, LDB, LDX, N, NRHS

          REAL           RCOND

          REAL           B( LDB, * ), BERR( * ), D( * ), DF( * ),
                         E( * ), EF( * ), FERR( * ), WORK( * ), X(
                         LDX, * )

 PURPOSE
      SPTSVX uses the factorization A = L*D*L**T to compute the
      solution to a real system of linear equations A*X = B, where
      A is an N-by-N symmetric positive definite tridiagonal
      matrix and X and B are N-by-NRHS matrices.

      Error bounds on the solution and a condition estimate are
      also provided.

 DESCRIPTION
      The following steps are performed:

      1. If FACT = 'N', the matrix A is factored as A = L*D*L**T,
      where L
         is a unit lower bidiagonal matrix and D is diagonal.  The
         factorization can also be regarded as having the form
         A = U**T*D*U.

      2. The factored form of A is used to compute the condition
      number
         of the matrix A.  If the reciprocal of the condition
      number is
         less than machine precision, steps 3 and 4 are skipped.

      3. The system of equations is solved for X using the fac-
      tored form
         of A.

      4. Iterative refinement is applied to improve the computed
      solution
         matrix and calculate error bounds and backward error

      estimates
         for it.

 ARGUMENTS
      FACT    (input) CHARACTER*1
              Specifies whether or not the factored form of A has
              been supplied on entry.  = 'F':  On entry, DF and EF
              contain the factored form of A.  D, E, DF, and EF
              will not be modified.  = 'N':  The matrix A will be
              copied to DF and EF and factored.

      N       (input) INTEGER
              The order of the matrix A.  N >= 0.

      NRHS    (input) INTEGER
              The number of right hand sides, i.e., the number of
              columns of the matrices B and X.  NRHS >= 0.

      D       (input) REAL array, dimension (N)
              The n diagonal elements of the tridiagonal matrix A.

      E       (input) REAL array, dimension (N-1)
              The (n-1) subdiagonal elements of the tridiagonal
              matrix A.

      DF      (input or output) REAL array, dimension (N)
              If FACT = 'F', then DF is an input argument and on
              entry contains the n diagonal elements of the diago-
              nal matrix D from the L*D*L**T factorization of A.
              If FACT = 'N', then DF is an output argument and on
              exit contains the n diagonal elements of the diago-
              nal matrix D from the L*D*L**T factorization of A.

      EF      (input or output) REAL array, dimension (N-1)
              If FACT = 'F', then EF is an input argument and on
              entry contains the (n-1) subdiagonal elements of the
              unit bidiagonal factor L from the L*D*L**T factori-
              zation of A.  If FACT = 'N', then EF is an output
              argument and on exit contains the (n-1) subdiagonal
              elements of the unit bidiagonal factor L from the
              L*D*L**T factorization of A.

      B       (input) REAL array, dimension (LDB,NRHS)
              The N-by-NRHS right hand side matrix B.

      LDB     (input) INTEGER
              The leading dimension of the array B.  LDB >=
              max(1,N).

      X       (output) REAL array, dimension (LDX,NRHS)
              If INFO = 0, the N-by-NRHS solution matrix X.

      LDX     (input) INTEGER
              The leading dimension of the array X.  LDX >=
              max(1,N).

      RCOND   (output) REAL
              The reciprocal condition number of the matrix A.  If
              RCOND is less than the machine precision (in partic-
              ular, if RCOND = 0), the matrix is singular to work-
              ing precision.  This condition is indicated by a
              return code of INFO > 0, and the solution and error
              bounds are not computed.

      FERR    (output) REAL array, dimension (NRHS)
              The estimated forward error bounds for each solution
              vector X(j) (the j-th column of the solution matrix
              X).  If XTRUE is the true solution corresponding to
              X(j), FERR(j) bounds the magnitude of the largest
              element in (X(j) - XTRUE) divided by the magnitude
              of the largest element in X(j).

      BERR    (output) REAL array, dimension (NRHS)
              The componentwise relative backward error of each
              solution vector X(j) (i.e., the smallest relative
              change in any element of A or B that makes X(j) an
              exact solution).

      WORK    (workspace) REAL array, dimension (2*N)

      INFO    (output) INTEGER
              = 0:  successful exit
              < 0:  if INFO = -i, the i-th argument had an illegal
              value
              > 0:  if INFO = i, and i is <= N  the leading minor
              of order i of A is not positive definite, so the
              factorization could not be completed unless i = N,
              and the solution and error bounds could not be com-
              puted.  = N+1 RCOND is less than machine precision.
              The factorization has been completed, but the matrix
              is singular to working precision, and the solution
              and error bounds have not been computed.