00001 /* zgtsvx.f -- translated by f2c (version 20061008). 00002 You must link the resulting object file with libf2c: 00003 on Microsoft Windows system, link with libf2c.lib; 00004 on Linux or Unix systems, link with .../path/to/libf2c.a -lm 00005 or, if you install libf2c.a in a standard place, with -lf2c -lm 00006 -- in that order, at the end of the command line, as in 00007 cc *.o -lf2c -lm 00008 Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., 00009 00010 http://www.netlib.org/f2c/libf2c.zip 00011 */ 00012 00013 #include "f2c.h" 00014 #include "blaswrap.h" 00015 00016 /* Table of constant values */ 00017 00018 static integer c__1 = 1; 00019 00020 /* Subroutine */ int zgtsvx_(char *fact, char *trans, integer *n, integer * 00021 nrhs, doublecomplex *dl, doublecomplex *d__, doublecomplex *du, 00022 doublecomplex *dlf, doublecomplex *df, doublecomplex *duf, 00023 doublecomplex *du2, integer *ipiv, doublecomplex *b, integer *ldb, 00024 doublecomplex *x, integer *ldx, doublereal *rcond, doublereal *ferr, 00025 doublereal *berr, doublecomplex *work, doublereal *rwork, integer * 00026 info) 00027 { 00028 /* System generated locals */ 00029 integer b_dim1, b_offset, x_dim1, x_offset, i__1; 00030 00031 /* Local variables */ 00032 char norm[1]; 00033 extern logical lsame_(char *, char *); 00034 doublereal anorm; 00035 extern /* Subroutine */ int zcopy_(integer *, doublecomplex *, integer *, 00036 doublecomplex *, integer *); 00037 extern doublereal dlamch_(char *); 00038 logical nofact; 00039 extern /* Subroutine */ int xerbla_(char *, integer *); 00040 extern doublereal zlangt_(char *, integer *, doublecomplex *, 00041 doublecomplex *, doublecomplex *); 00042 logical notran; 00043 extern /* Subroutine */ int zlacpy_(char *, integer *, integer *, 00044 doublecomplex *, integer *, doublecomplex *, integer *), 00045 zgtcon_(char *, integer *, doublecomplex *, doublecomplex *, 00046 doublecomplex *, doublecomplex *, integer *, doublereal *, 00047 doublereal *, doublecomplex *, integer *), zgtrfs_(char *, 00048 integer *, integer *, doublecomplex *, doublecomplex *, 00049 doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex * 00050 , doublecomplex *, integer *, doublecomplex *, integer *, 00051 doublecomplex *, integer *, doublereal *, doublereal *, 00052 doublecomplex *, doublereal *, integer *), zgttrf_( 00053 integer *, doublecomplex *, doublecomplex *, doublecomplex *, 00054 doublecomplex *, integer *, integer *), zgttrs_(char *, integer *, 00055 integer *, doublecomplex *, doublecomplex *, doublecomplex *, 00056 doublecomplex *, integer *, doublecomplex *, integer *, integer *); 00057 00058 00059 /* -- LAPACK routine (version 3.2) -- */ 00060 /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ 00061 /* November 2006 */ 00062 00063 /* .. Scalar Arguments .. */ 00064 /* .. */ 00065 /* .. Array Arguments .. */ 00066 /* .. */ 00067 00068 /* Purpose */ 00069 /* ======= */ 00070 00071 /* ZGTSVX uses the LU factorization to compute the solution to a complex */ 00072 /* system of linear equations A * X = B, A**T * X = B, or A**H * X = B, */ 00073 /* where A is a tridiagonal matrix of order N and X and B are N-by-NRHS */ 00074 /* matrices. */ 00075 00076 /* Error bounds on the solution and a condition estimate are also */ 00077 /* provided. */ 00078 00079 /* Description */ 00080 /* =========== */ 00081 00082 /* The following steps are performed: */ 00083 00084 /* 1. If FACT = 'N', the LU decomposition is used to factor the matrix A */ 00085 /* as A = L * U, where L is a product of permutation and unit lower */ 00086 /* bidiagonal matrices and U is upper triangular with nonzeros in */ 00087 /* only the main diagonal and first two superdiagonals. */ 00088 00089 /* 2. If some U(i,i)=0, so that U is exactly singular, then the routine */ 00090 /* returns with INFO = i. Otherwise, the factored form of A is used */ 00091 /* to estimate the condition number of the matrix A. If the */ 00092 /* reciprocal of the condition number is less than machine precision, */ 00093 /* INFO = N+1 is returned as a warning, but the routine still goes on */ 00094 /* to solve for X and compute error bounds as described below. */ 00095 00096 /* 3. The system of equations is solved for X using the factored form */ 00097 /* of A. */ 00098 00099 /* 4. Iterative refinement is applied to improve the computed solution */ 00100 /* matrix and calculate error bounds and backward error estimates */ 00101 /* for it. */ 00102 00103 /* Arguments */ 00104 /* ========= */ 00105 00106 /* FACT (input) CHARACTER*1 */ 00107 /* Specifies whether or not the factored form of A has been */ 00108 /* supplied on entry. */ 00109 /* = 'F': DLF, DF, DUF, DU2, and IPIV contain the factored form */ 00110 /* of A; DL, D, DU, DLF, DF, DUF, DU2 and IPIV will not */ 00111 /* be modified. */ 00112 /* = 'N': The matrix will be copied to DLF, DF, and DUF */ 00113 /* and factored. */ 00114 00115 /* TRANS (input) CHARACTER*1 */ 00116 /* Specifies the form of the system of equations: */ 00117 /* = 'N': A * X = B (No transpose) */ 00118 /* = 'T': A**T * X = B (Transpose) */ 00119 /* = 'C': A**H * X = B (Conjugate transpose) */ 00120 00121 /* N (input) INTEGER */ 00122 /* The order of the matrix A. N >= 0. */ 00123 00124 /* NRHS (input) INTEGER */ 00125 /* The number of right hand sides, i.e., the number of columns */ 00126 /* of the matrix B. NRHS >= 0. */ 00127 00128 /* DL (input) COMPLEX*16 array, dimension (N-1) */ 00129 /* The (n-1) subdiagonal elements of A. */ 00130 00131 /* D (input) COMPLEX*16 array, dimension (N) */ 00132 /* The n diagonal elements of A. */ 00133 00134 /* DU (input) COMPLEX*16 array, dimension (N-1) */ 00135 /* The (n-1) superdiagonal elements of A. */ 00136 00137 /* DLF (input or output) COMPLEX*16 array, dimension (N-1) */ 00138 /* If FACT = 'F', then DLF is an input argument and on entry */ 00139 /* contains the (n-1) multipliers that define the matrix L from */ 00140 /* the LU factorization of A as computed by ZGTTRF. */ 00141 00142 /* If FACT = 'N', then DLF is an output argument and on exit */ 00143 /* contains the (n-1) multipliers that define the matrix L from */ 00144 /* the LU factorization of A. */ 00145 00146 /* DF (input or output) COMPLEX*16 array, dimension (N) */ 00147 /* If FACT = 'F', then DF is an input argument and on entry */ 00148 /* contains the n diagonal elements of the upper triangular */ 00149 /* matrix U from the LU factorization of A. */ 00150 00151 /* If FACT = 'N', then DF is an output argument and on exit */ 00152 /* contains the n diagonal elements of the upper triangular */ 00153 /* matrix U from the LU factorization of A. */ 00154 00155 /* DUF (input or output) COMPLEX*16 array, dimension (N-1) */ 00156 /* If FACT = 'F', then DUF is an input argument and on entry */ 00157 /* contains the (n-1) elements of the first superdiagonal of U. */ 00158 00159 /* If FACT = 'N', then DUF is an output argument and on exit */ 00160 /* contains the (n-1) elements of the first superdiagonal of U. */ 00161 00162 /* DU2 (input or output) COMPLEX*16 array, dimension (N-2) */ 00163 /* If FACT = 'F', then DU2 is an input argument and on entry */ 00164 /* contains the (n-2) elements of the second superdiagonal of */ 00165 /* U. */ 00166 00167 /* If FACT = 'N', then DU2 is an output argument and on exit */ 00168 /* contains the (n-2) elements of the second superdiagonal of */ 00169 /* U. */ 00170 00171 /* IPIV (input or output) INTEGER array, dimension (N) */ 00172 /* If FACT = 'F', then IPIV is an input argument and on entry */ 00173 /* contains the pivot indices from the LU factorization of A as */ 00174 /* computed by ZGTTRF. */ 00175 00176 /* If FACT = 'N', then IPIV is an output argument and on exit */ 00177 /* contains the pivot indices from the LU factorization of A; */ 00178 /* row i of the matrix was interchanged with row IPIV(i). */ 00179 /* IPIV(i) will always be either i or i+1; IPIV(i) = i indicates */ 00180 /* a row interchange was not required. */ 00181 00182 /* B (input) COMPLEX*16 array, dimension (LDB,NRHS) */ 00183 /* The N-by-NRHS right hand side matrix B. */ 00184 00185 /* LDB (input) INTEGER */ 00186 /* The leading dimension of the array B. LDB >= max(1,N). */ 00187 00188 /* X (output) COMPLEX*16 array, dimension (LDX,NRHS) */ 00189 /* If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X. */ 00190 00191 /* LDX (input) INTEGER */ 00192 /* The leading dimension of the array X. LDX >= max(1,N). */ 00193 00194 /* RCOND (output) DOUBLE PRECISION */ 00195 /* The estimate of the reciprocal condition number of the matrix */ 00196 /* A. If RCOND is less than the machine precision (in */ 00197 /* particular, if RCOND = 0), the matrix is singular to working */ 00198 /* precision. This condition is indicated by a return code of */ 00199 /* INFO > 0. */ 00200 00201 /* FERR (output) DOUBLE PRECISION array, dimension (NRHS) */ 00202 /* The estimated forward error bound for each solution vector */ 00203 /* X(j) (the j-th column of the solution matrix X). */ 00204 /* If XTRUE is the true solution corresponding to X(j), FERR(j) */ 00205 /* is an estimated upper bound for the magnitude of the largest */ 00206 /* element in (X(j) - XTRUE) divided by the magnitude of the */ 00207 /* largest element in X(j). The estimate is as reliable as */ 00208 /* the estimate for RCOND, and is almost always a slight */ 00209 /* overestimate of the true error. */ 00210 00211 /* BERR (output) DOUBLE PRECISION array, dimension (NRHS) */ 00212 /* The componentwise relative backward error of each solution */ 00213 /* vector X(j) (i.e., the smallest relative change in */ 00214 /* any element of A or B that makes X(j) an exact solution). */ 00215 00216 /* WORK (workspace) COMPLEX*16 array, dimension (2*N) */ 00217 00218 /* RWORK (workspace) DOUBLE PRECISION array, dimension (N) */ 00219 00220 /* INFO (output) INTEGER */ 00221 /* = 0: successful exit */ 00222 /* < 0: if INFO = -i, the i-th argument had an illegal value */ 00223 /* > 0: if INFO = i, and i is */ 00224 /* <= N: U(i,i) is exactly zero. The factorization */ 00225 /* has not been completed unless i = N, but the */ 00226 /* factor U is exactly singular, so the solution */ 00227 /* and error bounds could not be computed. */ 00228 /* RCOND = 0 is returned. */ 00229 /* = N+1: U is nonsingular, but RCOND is less than machine */ 00230 /* precision, meaning that the matrix is singular */ 00231 /* to working precision. Nevertheless, the */ 00232 /* solution and error bounds are computed because */ 00233 /* there are a number of situations where the */ 00234 /* computed solution can be more accurate than the */ 00235 /* value of RCOND would suggest. */ 00236 00237 /* ===================================================================== */ 00238 00239 /* .. Parameters .. */ 00240 /* .. */ 00241 /* .. Local Scalars .. */ 00242 /* .. */ 00243 /* .. External Functions .. */ 00244 /* .. */ 00245 /* .. External Subroutines .. */ 00246 /* .. */ 00247 /* .. Intrinsic Functions .. */ 00248 /* .. */ 00249 /* .. Executable Statements .. */ 00250 00251 /* Parameter adjustments */ 00252 --dl; 00253 --d__; 00254 --du; 00255 --dlf; 00256 --df; 00257 --duf; 00258 --du2; 00259 --ipiv; 00260 b_dim1 = *ldb; 00261 b_offset = 1 + b_dim1; 00262 b -= b_offset; 00263 x_dim1 = *ldx; 00264 x_offset = 1 + x_dim1; 00265 x -= x_offset; 00266 --ferr; 00267 --berr; 00268 --work; 00269 --rwork; 00270 00271 /* Function Body */ 00272 *info = 0; 00273 nofact = lsame_(fact, "N"); 00274 notran = lsame_(trans, "N"); 00275 if (! nofact && ! lsame_(fact, "F")) { 00276 *info = -1; 00277 } else if (! notran && ! lsame_(trans, "T") && ! 00278 lsame_(trans, "C")) { 00279 *info = -2; 00280 } else if (*n < 0) { 00281 *info = -3; 00282 } else if (*nrhs < 0) { 00283 *info = -4; 00284 } else if (*ldb < max(1,*n)) { 00285 *info = -14; 00286 } else if (*ldx < max(1,*n)) { 00287 *info = -16; 00288 } 00289 if (*info != 0) { 00290 i__1 = -(*info); 00291 xerbla_("ZGTSVX", &i__1); 00292 return 0; 00293 } 00294 00295 if (nofact) { 00296 00297 /* Compute the LU factorization of A. */ 00298 00299 zcopy_(n, &d__[1], &c__1, &df[1], &c__1); 00300 if (*n > 1) { 00301 i__1 = *n - 1; 00302 zcopy_(&i__1, &dl[1], &c__1, &dlf[1], &c__1); 00303 i__1 = *n - 1; 00304 zcopy_(&i__1, &du[1], &c__1, &duf[1], &c__1); 00305 } 00306 zgttrf_(n, &dlf[1], &df[1], &duf[1], &du2[1], &ipiv[1], info); 00307 00308 /* Return if INFO is non-zero. */ 00309 00310 if (*info > 0) { 00311 *rcond = 0.; 00312 return 0; 00313 } 00314 } 00315 00316 /* Compute the norm of the matrix A. */ 00317 00318 if (notran) { 00319 *(unsigned char *)norm = '1'; 00320 } else { 00321 *(unsigned char *)norm = 'I'; 00322 } 00323 anorm = zlangt_(norm, n, &dl[1], &d__[1], &du[1]); 00324 00325 /* Compute the reciprocal of the condition number of A. */ 00326 00327 zgtcon_(norm, n, &dlf[1], &df[1], &duf[1], &du2[1], &ipiv[1], &anorm, 00328 rcond, &work[1], info); 00329 00330 /* Compute the solution vectors X. */ 00331 00332 zlacpy_("Full", n, nrhs, &b[b_offset], ldb, &x[x_offset], ldx); 00333 zgttrs_(trans, n, nrhs, &dlf[1], &df[1], &duf[1], &du2[1], &ipiv[1], &x[ 00334 x_offset], ldx, info); 00335 00336 /* Use iterative refinement to improve the computed solutions and */ 00337 /* compute error bounds and backward error estimates for them. */ 00338 00339 zgtrfs_(trans, n, nrhs, &dl[1], &d__[1], &du[1], &dlf[1], &df[1], &duf[1], 00340 &du2[1], &ipiv[1], &b[b_offset], ldb, &x[x_offset], ldx, &ferr[1] 00341 , &berr[1], &work[1], &rwork[1], info); 00342 00343 /* Set INFO = N+1 if the matrix is singular to working precision. */ 00344 00345 if (*rcond < dlamch_("Epsilon")) { 00346 *info = *n + 1; 00347 } 00348 00349 return 0; 00350 00351 /* End of ZGTSVX */ 00352 00353 } /* zgtsvx_ */