00001 SUBROUTINE DGTSVX( 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 DOUBLE PRECISION RCOND 00014 * .. 00015 * .. Array Arguments .. 00016 INTEGER IPIV( * ), IWORK( * ) 00017 DOUBLE PRECISION B( LDB, * ), BERR( * ), D( * ), DF( * ), 00018 $ DL( * ), DLF( * ), DU( * ), DU2( * ), DUF( * ), 00019 $ FERR( * ), WORK( * ), X( LDX, * ) 00020 * .. 00021 * 00022 * Purpose 00023 * ======= 00024 * 00025 * DGTSVX 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) DOUBLE PRECISION array, dimension (N-1) 00083 * The (n-1) subdiagonal elements of A. 00084 * 00085 * D (input) DOUBLE PRECISION array, dimension (N) 00086 * The n diagonal elements of A. 00087 * 00088 * DU (input) DOUBLE PRECISION array, dimension (N-1) 00089 * The (n-1) superdiagonal elements of A. 00090 * 00091 * DLF (input or output) DOUBLE PRECISION 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 DGTTRF. 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) DOUBLE PRECISION 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) DOUBLE PRECISION 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) DOUBLE PRECISION 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 DGTTRF. 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) DOUBLE PRECISION 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) DOUBLE PRECISION 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) DOUBLE PRECISION 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) DOUBLE PRECISION 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) DOUBLE PRECISION 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) DOUBLE PRECISION 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 DOUBLE PRECISION ZERO 00195 PARAMETER ( ZERO = 0.0D+0 ) 00196 * .. 00197 * .. Local Scalars .. 00198 LOGICAL NOFACT, NOTRAN 00199 CHARACTER NORM 00200 DOUBLE PRECISION ANORM 00201 * .. 00202 * .. External Functions .. 00203 LOGICAL LSAME 00204 DOUBLE PRECISION DLAMCH, DLANGT 00205 EXTERNAL LSAME, DLAMCH, DLANGT 00206 * .. 00207 * .. External Subroutines .. 00208 EXTERNAL DCOPY, DGTCON, DGTRFS, DGTTRF, DGTTRS, DLACPY, 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( 'DGTSVX', -INFO ) 00235 RETURN 00236 END IF 00237 * 00238 IF( NOFACT ) THEN 00239 * 00240 * Compute the LU factorization of A. 00241 * 00242 CALL DCOPY( N, D, 1, DF, 1 ) 00243 IF( N.GT.1 ) THEN 00244 CALL DCOPY( N-1, DL, 1, DLF, 1 ) 00245 CALL DCOPY( N-1, DU, 1, DUF, 1 ) 00246 END IF 00247 CALL DGTTRF( 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 = DLANGT( NORM, N, DL, D, DU ) 00265 * 00266 * Compute the reciprocal of the condition number of A. 00267 * 00268 CALL DGTCON( NORM, N, DLF, DF, DUF, DU2, IPIV, ANORM, RCOND, WORK, 00269 $ IWORK, INFO ) 00270 * 00271 * Compute the solution vectors X. 00272 * 00273 CALL DLACPY( 'Full', N, NRHS, B, LDB, X, LDX ) 00274 CALL DGTTRS( 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 DGTRFS( 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.DLAMCH( 'Epsilon' ) ) 00286 $ INFO = N + 1 00287 * 00288 RETURN 00289 * 00290 * End of DGTSVX 00291 * 00292 END
1.7.2