![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZGTTS2 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download ZGTTS2 + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgtts2.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgtts2.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgtts2.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE ZGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB ) 00022 * 00023 * .. Scalar Arguments .. 00024 * INTEGER ITRANS, LDB, N, NRHS 00025 * .. 00026 * .. Array Arguments .. 00027 * INTEGER IPIV( * ) 00028 * COMPLEX*16 B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * ) 00029 * .. 00030 * 00031 * 00032 *> \par Purpose: 00033 * ============= 00034 *> 00035 *> \verbatim 00036 *> 00037 *> ZGTTS2 solves one of the systems of equations 00038 *> A * X = B, A**T * X = B, or A**H * X = B, 00039 *> with a tridiagonal matrix A using the LU factorization computed 00040 *> by ZGTTRF. 00041 *> \endverbatim 00042 * 00043 * Arguments: 00044 * ========== 00045 * 00046 *> \param[in] ITRANS 00047 *> \verbatim 00048 *> ITRANS is INTEGER 00049 *> Specifies the form of the system of equations. 00050 *> = 0: A * X = B (No transpose) 00051 *> = 1: A**T * X = B (Transpose) 00052 *> = 2: A**H * X = B (Conjugate transpose) 00053 *> \endverbatim 00054 *> 00055 *> \param[in] N 00056 *> \verbatim 00057 *> N is INTEGER 00058 *> The order of the matrix A. 00059 *> \endverbatim 00060 *> 00061 *> \param[in] NRHS 00062 *> \verbatim 00063 *> NRHS is INTEGER 00064 *> The number of right hand sides, i.e., the number of columns 00065 *> of the matrix B. NRHS >= 0. 00066 *> \endverbatim 00067 *> 00068 *> \param[in] DL 00069 *> \verbatim 00070 *> DL is COMPLEX*16 array, dimension (N-1) 00071 *> The (n-1) multipliers that define the matrix L from the 00072 *> LU factorization of A. 00073 *> \endverbatim 00074 *> 00075 *> \param[in] D 00076 *> \verbatim 00077 *> D is COMPLEX*16 array, dimension (N) 00078 *> The n diagonal elements of the upper triangular matrix U from 00079 *> the LU factorization of A. 00080 *> \endverbatim 00081 *> 00082 *> \param[in] DU 00083 *> \verbatim 00084 *> DU is COMPLEX*16 array, dimension (N-1) 00085 *> The (n-1) elements of the first super-diagonal of U. 00086 *> \endverbatim 00087 *> 00088 *> \param[in] DU2 00089 *> \verbatim 00090 *> DU2 is COMPLEX*16 array, dimension (N-2) 00091 *> The (n-2) elements of the second super-diagonal of U. 00092 *> \endverbatim 00093 *> 00094 *> \param[in] IPIV 00095 *> \verbatim 00096 *> IPIV is INTEGER array, dimension (N) 00097 *> The pivot indices; for 1 <= i <= n, row i of the matrix was 00098 *> interchanged with row IPIV(i). IPIV(i) will always be either 00099 *> i or i+1; IPIV(i) = i indicates a row interchange was not 00100 *> required. 00101 *> \endverbatim 00102 *> 00103 *> \param[in,out] B 00104 *> \verbatim 00105 *> B is COMPLEX*16 array, dimension (LDB,NRHS) 00106 *> On entry, the matrix of right hand side vectors B. 00107 *> On exit, B is overwritten by the solution vectors X. 00108 *> \endverbatim 00109 *> 00110 *> \param[in] LDB 00111 *> \verbatim 00112 *> LDB is INTEGER 00113 *> The leading dimension of the array B. LDB >= max(1,N). 00114 *> \endverbatim 00115 * 00116 * Authors: 00117 * ======== 00118 * 00119 *> \author Univ. of Tennessee 00120 *> \author Univ. of California Berkeley 00121 *> \author Univ. of Colorado Denver 00122 *> \author NAG Ltd. 00123 * 00124 *> \date November 2011 00125 * 00126 *> \ingroup complex16OTHERauxiliary 00127 * 00128 * ===================================================================== 00129 SUBROUTINE ZGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB ) 00130 * 00131 * -- LAPACK auxiliary routine (version 3.4.0) -- 00132 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00133 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00134 * November 2011 00135 * 00136 * .. Scalar Arguments .. 00137 INTEGER ITRANS, LDB, N, NRHS 00138 * .. 00139 * .. Array Arguments .. 00140 INTEGER IPIV( * ) 00141 COMPLEX*16 B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * ) 00142 * .. 00143 * 00144 * ===================================================================== 00145 * 00146 * .. Local Scalars .. 00147 INTEGER I, J 00148 COMPLEX*16 TEMP 00149 * .. 00150 * .. Intrinsic Functions .. 00151 INTRINSIC DCONJG 00152 * .. 00153 * .. Executable Statements .. 00154 * 00155 * Quick return if possible 00156 * 00157 IF( N.EQ.0 .OR. NRHS.EQ.0 ) 00158 $ RETURN 00159 * 00160 IF( ITRANS.EQ.0 ) THEN 00161 * 00162 * Solve A*X = B using the LU factorization of A, 00163 * overwriting each right hand side vector with its solution. 00164 * 00165 IF( NRHS.LE.1 ) THEN 00166 J = 1 00167 10 CONTINUE 00168 * 00169 * Solve L*x = b. 00170 * 00171 DO 20 I = 1, N - 1 00172 IF( IPIV( I ).EQ.I ) THEN 00173 B( I+1, J ) = B( I+1, J ) - DL( I )*B( I, J ) 00174 ELSE 00175 TEMP = B( I, J ) 00176 B( I, J ) = B( I+1, J ) 00177 B( I+1, J ) = TEMP - DL( I )*B( I, J ) 00178 END IF 00179 20 CONTINUE 00180 * 00181 * Solve U*x = b. 00182 * 00183 B( N, J ) = B( N, J ) / D( N ) 00184 IF( N.GT.1 ) 00185 $ B( N-1, J ) = ( B( N-1, J )-DU( N-1 )*B( N, J ) ) / 00186 $ D( N-1 ) 00187 DO 30 I = N - 2, 1, -1 00188 B( I, J ) = ( B( I, J )-DU( I )*B( I+1, J )-DU2( I )* 00189 $ B( I+2, J ) ) / D( I ) 00190 30 CONTINUE 00191 IF( J.LT.NRHS ) THEN 00192 J = J + 1 00193 GO TO 10 00194 END IF 00195 ELSE 00196 DO 60 J = 1, NRHS 00197 * 00198 * Solve L*x = b. 00199 * 00200 DO 40 I = 1, N - 1 00201 IF( IPIV( I ).EQ.I ) THEN 00202 B( I+1, J ) = B( I+1, J ) - DL( I )*B( I, J ) 00203 ELSE 00204 TEMP = B( I, J ) 00205 B( I, J ) = B( I+1, J ) 00206 B( I+1, J ) = TEMP - DL( I )*B( I, J ) 00207 END IF 00208 40 CONTINUE 00209 * 00210 * Solve U*x = b. 00211 * 00212 B( N, J ) = B( N, J ) / D( N ) 00213 IF( N.GT.1 ) 00214 $ B( N-1, J ) = ( B( N-1, J )-DU( N-1 )*B( N, J ) ) / 00215 $ D( N-1 ) 00216 DO 50 I = N - 2, 1, -1 00217 B( I, J ) = ( B( I, J )-DU( I )*B( I+1, J )-DU2( I )* 00218 $ B( I+2, J ) ) / D( I ) 00219 50 CONTINUE 00220 60 CONTINUE 00221 END IF 00222 ELSE IF( ITRANS.EQ.1 ) THEN 00223 * 00224 * Solve A**T * X = B. 00225 * 00226 IF( NRHS.LE.1 ) THEN 00227 J = 1 00228 70 CONTINUE 00229 * 00230 * Solve U**T * x = b. 00231 * 00232 B( 1, J ) = B( 1, J ) / D( 1 ) 00233 IF( N.GT.1 ) 00234 $ B( 2, J ) = ( B( 2, J )-DU( 1 )*B( 1, J ) ) / D( 2 ) 00235 DO 80 I = 3, N 00236 B( I, J ) = ( B( I, J )-DU( I-1 )*B( I-1, J )-DU2( I-2 )* 00237 $ B( I-2, J ) ) / D( I ) 00238 80 CONTINUE 00239 * 00240 * Solve L**T * x = b. 00241 * 00242 DO 90 I = N - 1, 1, -1 00243 IF( IPIV( I ).EQ.I ) THEN 00244 B( I, J ) = B( I, J ) - DL( I )*B( I+1, J ) 00245 ELSE 00246 TEMP = B( I+1, J ) 00247 B( I+1, J ) = B( I, J ) - DL( I )*TEMP 00248 B( I, J ) = TEMP 00249 END IF 00250 90 CONTINUE 00251 IF( J.LT.NRHS ) THEN 00252 J = J + 1 00253 GO TO 70 00254 END IF 00255 ELSE 00256 DO 120 J = 1, NRHS 00257 * 00258 * Solve U**T * x = b. 00259 * 00260 B( 1, J ) = B( 1, J ) / D( 1 ) 00261 IF( N.GT.1 ) 00262 $ B( 2, J ) = ( B( 2, J )-DU( 1 )*B( 1, J ) ) / D( 2 ) 00263 DO 100 I = 3, N 00264 B( I, J ) = ( B( I, J )-DU( I-1 )*B( I-1, J )- 00265 $ DU2( I-2 )*B( I-2, J ) ) / D( I ) 00266 100 CONTINUE 00267 * 00268 * Solve L**T * x = b. 00269 * 00270 DO 110 I = N - 1, 1, -1 00271 IF( IPIV( I ).EQ.I ) THEN 00272 B( I, J ) = B( I, J ) - DL( I )*B( I+1, J ) 00273 ELSE 00274 TEMP = B( I+1, J ) 00275 B( I+1, J ) = B( I, J ) - DL( I )*TEMP 00276 B( I, J ) = TEMP 00277 END IF 00278 110 CONTINUE 00279 120 CONTINUE 00280 END IF 00281 ELSE 00282 * 00283 * Solve A**H * X = B. 00284 * 00285 IF( NRHS.LE.1 ) THEN 00286 J = 1 00287 130 CONTINUE 00288 * 00289 * Solve U**H * x = b. 00290 * 00291 B( 1, J ) = B( 1, J ) / DCONJG( D( 1 ) ) 00292 IF( N.GT.1 ) 00293 $ B( 2, J ) = ( B( 2, J )-DCONJG( DU( 1 ) )*B( 1, J ) ) / 00294 $ DCONJG( D( 2 ) ) 00295 DO 140 I = 3, N 00296 B( I, J ) = ( B( I, J )-DCONJG( DU( I-1 ) )*B( I-1, J )- 00297 $ DCONJG( DU2( I-2 ) )*B( I-2, J ) ) / 00298 $ DCONJG( D( I ) ) 00299 140 CONTINUE 00300 * 00301 * Solve L**H * x = b. 00302 * 00303 DO 150 I = N - 1, 1, -1 00304 IF( IPIV( I ).EQ.I ) THEN 00305 B( I, J ) = B( I, J ) - DCONJG( DL( I ) )*B( I+1, J ) 00306 ELSE 00307 TEMP = B( I+1, J ) 00308 B( I+1, J ) = B( I, J ) - DCONJG( DL( I ) )*TEMP 00309 B( I, J ) = TEMP 00310 END IF 00311 150 CONTINUE 00312 IF( J.LT.NRHS ) THEN 00313 J = J + 1 00314 GO TO 130 00315 END IF 00316 ELSE 00317 DO 180 J = 1, NRHS 00318 * 00319 * Solve U**H * x = b. 00320 * 00321 B( 1, J ) = B( 1, J ) / DCONJG( D( 1 ) ) 00322 IF( N.GT.1 ) 00323 $ B( 2, J ) = ( B( 2, J )-DCONJG( DU( 1 ) )*B( 1, J ) ) 00324 $ / DCONJG( D( 2 ) ) 00325 DO 160 I = 3, N 00326 B( I, J ) = ( B( I, J )-DCONJG( DU( I-1 ) )* 00327 $ B( I-1, J )-DCONJG( DU2( I-2 ) )* 00328 $ B( I-2, J ) ) / DCONJG( D( I ) ) 00329 160 CONTINUE 00330 * 00331 * Solve L**H * x = b. 00332 * 00333 DO 170 I = N - 1, 1, -1 00334 IF( IPIV( I ).EQ.I ) THEN 00335 B( I, J ) = B( I, J ) - DCONJG( DL( I ) )* 00336 $ B( I+1, J ) 00337 ELSE 00338 TEMP = B( I+1, J ) 00339 B( I+1, J ) = B( I, J ) - DCONJG( DL( I ) )*TEMP 00340 B( I, J ) = TEMP 00341 END IF 00342 170 CONTINUE 00343 180 CONTINUE 00344 END IF 00345 END IF 00346 * 00347 * End of ZGTTS2 00348 * 00349 END