 LAPACK 3.3.1 Linear Algebra PACKage

# sgtsvx.f

Go to the documentation of this file.
```00001       SUBROUTINE SGTSVX( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF,
00002      \$                   DU2, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR,
00003      \$                   WORK, IWORK, INFO )
00004 *
00005 *  -- LAPACK routine (version 3.2) --
00006 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00007 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00008 *     November 2006
00009 *
00010 *     .. Scalar Arguments ..
00011       CHARACTER          FACT, TRANS
00012       INTEGER            INFO, LDB, LDX, N, NRHS
00013       REAL               RCOND
00014 *     ..
00015 *     .. Array Arguments ..
00016       INTEGER            IPIV( * ), IWORK( * )
00017       REAL               B( LDB, * ), BERR( * ), D( * ), DF( * ),
00018      \$                   DL( * ), DLF( * ), DU( * ), DU2( * ), DUF( * ),
00019      \$                   FERR( * ), WORK( * ), X( LDX, * )
00020 *     ..
00021 *
00022 *  Purpose
00023 *  =======
00024 *
00025 *  SGTSVX uses the LU factorization to compute the solution to a real
00026 *  system of linear equations A * X = B or A**T * X = B,
00027 *  where A is a tridiagonal matrix of order N and X and B are N-by-NRHS
00028 *  matrices.
00029 *
00030 *  Error bounds on the solution and a condition estimate are also
00031 *  provided.
00032 *
00033 *  Description
00034 *  ===========
00035 *
00036 *  The following steps are performed:
00037 *
00038 *  1. If FACT = 'N', the LU decomposition is used to factor the matrix A
00039 *     as A = L * U, where L is a product of permutation and unit lower
00040 *     bidiagonal matrices and U is upper triangular with nonzeros in
00041 *     only the main diagonal and first two superdiagonals.
00042 *
00043 *  2. If some U(i,i)=0, so that U is exactly singular, then the routine
00044 *     returns with INFO = i. Otherwise, the factored form of A is used
00045 *     to estimate the condition number of the matrix A.  If the
00046 *     reciprocal of the condition number is less than machine precision,
00047 *     INFO = N+1 is returned as a warning, but the routine still goes on
00048 *     to solve for X and compute error bounds as described below.
00049 *
00050 *  3. The system of equations is solved for X using the factored form
00051 *     of A.
00052 *
00053 *  4. Iterative refinement is applied to improve the computed solution
00054 *     matrix and calculate error bounds and backward error estimates
00055 *     for it.
00056 *
00057 *  Arguments
00058 *  =========
00059 *
00060 *  FACT    (input) CHARACTER*1
00061 *          Specifies whether or not the factored form of A has been
00062 *          supplied on entry.
00063 *          = 'F':  DLF, DF, DUF, DU2, and IPIV contain the factored
00064 *                  form of A; DL, D, DU, DLF, DF, DUF, DU2 and IPIV
00065 *                  will not be modified.
00066 *          = 'N':  The matrix will be copied to DLF, DF, and DUF
00067 *                  and factored.
00068 *
00069 *  TRANS   (input) CHARACTER*1
00070 *          Specifies the form of the system of equations:
00071 *          = 'N':  A * X = B     (No transpose)
00072 *          = 'T':  A**T * X = B  (Transpose)
00073 *          = 'C':  A**H * X = B  (Conjugate transpose = Transpose)
00074 *
00075 *  N       (input) INTEGER
00076 *          The order of the matrix A.  N >= 0.
00077 *
00078 *  NRHS    (input) INTEGER
00079 *          The number of right hand sides, i.e., the number of columns
00080 *          of the matrix B.  NRHS >= 0.
00081 *
00082 *  DL      (input) REAL array, dimension (N-1)
00083 *          The (n-1) subdiagonal elements of A.
00084 *
00085 *  D       (input) REAL array, dimension (N)
00086 *          The n diagonal elements of A.
00087 *
00088 *  DU      (input) REAL array, dimension (N-1)
00089 *          The (n-1) superdiagonal elements of A.
00090 *
00091 *  DLF     (input or output) REAL array, dimension (N-1)
00092 *          If FACT = 'F', then DLF is an input argument and on entry
00093 *          contains the (n-1) multipliers that define the matrix L from
00094 *          the LU factorization of A as computed by SGTTRF.
00095 *
00096 *          If FACT = 'N', then DLF is an output argument and on exit
00097 *          contains the (n-1) multipliers that define the matrix L from
00098 *          the LU factorization of A.
00099 *
00100 *  DF      (input or output) REAL array, dimension (N)
00101 *          If FACT = 'F', then DF is an input argument and on entry
00102 *          contains the n diagonal elements of the upper triangular
00103 *          matrix U from the LU factorization of A.
00104 *
00105 *          If FACT = 'N', then DF is an output argument and on exit
00106 *          contains the n diagonal elements of the upper triangular
00107 *          matrix U from the LU factorization of A.
00108 *
00109 *  DUF     (input or output) REAL array, dimension (N-1)
00110 *          If FACT = 'F', then DUF is an input argument and on entry
00111 *          contains the (n-1) elements of the first superdiagonal of U.
00112 *
00113 *          If FACT = 'N', then DUF is an output argument and on exit
00114 *          contains the (n-1) elements of the first superdiagonal of U.
00115 *
00116 *  DU2     (input or output) REAL array, dimension (N-2)
00117 *          If FACT = 'F', then DU2 is an input argument and on entry
00118 *          contains the (n-2) elements of the second superdiagonal of
00119 *          U.
00120 *
00121 *          If FACT = 'N', then DU2 is an output argument and on exit
00122 *          contains the (n-2) elements of the second superdiagonal of
00123 *          U.
00124 *
00125 *  IPIV    (input or output) INTEGER array, dimension (N)
00126 *          If FACT = 'F', then IPIV is an input argument and on entry
00127 *          contains the pivot indices from the LU factorization of A as
00128 *          computed by SGTTRF.
00129 *
00130 *          If FACT = 'N', then IPIV is an output argument and on exit
00131 *          contains the pivot indices from the LU factorization of A;
00132 *          row i of the matrix was interchanged with row IPIV(i).
00133 *          IPIV(i) will always be either i or i+1; IPIV(i) = i indicates
00134 *          a row interchange was not required.
00135 *
00136 *  B       (input) REAL array, dimension (LDB,NRHS)
00137 *          The N-by-NRHS right hand side matrix B.
00138 *
00139 *  LDB     (input) INTEGER
00140 *          The leading dimension of the array B.  LDB >= max(1,N).
00141 *
00142 *  X       (output) REAL array, dimension (LDX,NRHS)
00143 *          If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X.
00144 *
00145 *  LDX     (input) INTEGER
00146 *          The leading dimension of the array X.  LDX >= max(1,N).
00147 *
00148 *  RCOND   (output) REAL
00149 *          The estimate of the reciprocal condition number of the matrix
00150 *          A.  If RCOND is less than the machine precision (in
00151 *          particular, if RCOND = 0), the matrix is singular to working
00152 *          precision.  This condition is indicated by a return code of
00153 *          INFO > 0.
00154 *
00155 *  FERR    (output) REAL array, dimension (NRHS)
00156 *          The estimated forward error bound for each solution vector
00157 *          X(j) (the j-th column of the solution matrix X).
00158 *          If XTRUE is the true solution corresponding to X(j), FERR(j)
00159 *          is an estimated upper bound for the magnitude of the largest
00160 *          element in (X(j) - XTRUE) divided by the magnitude of the
00161 *          largest element in X(j).  The estimate is as reliable as
00162 *          the estimate for RCOND, and is almost always a slight
00163 *          overestimate of the true error.
00164 *
00165 *  BERR    (output) REAL array, dimension (NRHS)
00166 *          The componentwise relative backward error of each solution
00167 *          vector X(j) (i.e., the smallest relative change in
00168 *          any element of A or B that makes X(j) an exact solution).
00169 *
00170 *  WORK    (workspace) REAL array, dimension (3*N)
00171 *
00172 *  IWORK   (workspace) INTEGER array, dimension (N)
00173 *
00174 *  INFO    (output) INTEGER
00175 *          = 0:  successful exit
00176 *          < 0:  if INFO = -i, the i-th argument had an illegal value
00177 *          > 0:  if INFO = i, and i is
00178 *                <= N:  U(i,i) is exactly zero.  The factorization
00179 *                       has not been completed unless i = N, but the
00180 *                       factor U is exactly singular, so the solution
00181 *                       and error bounds could not be computed.
00182 *                       RCOND = 0 is returned.
00183 *                = N+1: U is nonsingular, but RCOND is less than machine
00184 *                       precision, meaning that the matrix is singular
00185 *                       to working precision.  Nevertheless, the
00186 *                       solution and error bounds are computed because
00187 *                       there are a number of situations where the
00188 *                       computed solution can be more accurate than the
00189 *                       value of RCOND would suggest.
00190 *
00191 *  =====================================================================
00192 *
00193 *     .. Parameters ..
00194       REAL               ZERO
00195       PARAMETER          ( ZERO = 0.0E+0 )
00196 *     ..
00197 *     .. Local Scalars ..
00198       LOGICAL            NOFACT, NOTRAN
00199       CHARACTER          NORM
00200       REAL               ANORM
00201 *     ..
00202 *     .. External Functions ..
00203       LOGICAL            LSAME
00204       REAL               SLAMCH, SLANGT
00205       EXTERNAL           LSAME, SLAMCH, SLANGT
00206 *     ..
00207 *     .. External Subroutines ..
00208       EXTERNAL           SCOPY, SGTCON, SGTRFS, SGTTRF, SGTTRS, SLACPY,
00209      \$                   XERBLA
00210 *     ..
00211 *     .. Intrinsic Functions ..
00212       INTRINSIC          MAX
00213 *     ..
00214 *     .. Executable Statements ..
00215 *
00216       INFO = 0
00217       NOFACT = LSAME( FACT, 'N' )
00218       NOTRAN = LSAME( TRANS, 'N' )
00219       IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN
00220          INFO = -1
00221       ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
00222      \$         LSAME( TRANS, 'C' ) ) THEN
00223          INFO = -2
00224       ELSE IF( N.LT.0 ) THEN
00225          INFO = -3
00226       ELSE IF( NRHS.LT.0 ) THEN
00227          INFO = -4
00228       ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
00229          INFO = -14
00230       ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
00231          INFO = -16
00232       END IF
00233       IF( INFO.NE.0 ) THEN
00234          CALL XERBLA( 'SGTSVX', -INFO )
00235          RETURN
00236       END IF
00237 *
00238       IF( NOFACT ) THEN
00239 *
00240 *        Compute the LU factorization of A.
00241 *
00242          CALL SCOPY( N, D, 1, DF, 1 )
00243          IF( N.GT.1 ) THEN
00244             CALL SCOPY( N-1, DL, 1, DLF, 1 )
00245             CALL SCOPY( N-1, DU, 1, DUF, 1 )
00246          END IF
00247          CALL SGTTRF( N, DLF, DF, DUF, DU2, IPIV, INFO )
00248 *
00249 *        Return if INFO is non-zero.
00250 *
00251          IF( INFO.GT.0 )THEN
00252             RCOND = ZERO
00253             RETURN
00254          END IF
00255       END IF
00256 *
00257 *     Compute the norm of the matrix A.
00258 *
00259       IF( NOTRAN ) THEN
00260          NORM = '1'
00261       ELSE
00262          NORM = 'I'
00263       END IF
00264       ANORM = SLANGT( NORM, N, DL, D, DU )
00265 *
00266 *     Compute the reciprocal of the condition number of A.
00267 *
00268       CALL SGTCON( NORM, N, DLF, DF, DUF, DU2, IPIV, ANORM, RCOND, WORK,
00269      \$             IWORK, INFO )
00270 *
00271 *     Compute the solution vectors X.
00272 *
00273       CALL SLACPY( 'Full', N, NRHS, B, LDB, X, LDX )
00274       CALL SGTTRS( TRANS, N, NRHS, DLF, DF, DUF, DU2, IPIV, X, LDX,
00275      \$             INFO )
00276 *
00277 *     Use iterative refinement to improve the computed solutions and
00278 *     compute error bounds and backward error estimates for them.
00279 *
00280       CALL SGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, IPIV,
00281      \$             B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO )
00282 *
00283 *     Set INFO = N+1 if the matrix is singular to working precision.
00284 *
00285       IF( RCOND.LT.SLAMCH( 'Epsilon' ) )
00286      \$   INFO = N + 1
00287 *
00288       RETURN
00289 *
00290 *     End of SGTSVX
00291 *
00292       END
```