1*> \brief \b ZGTTS2 solves a system of linear equations with a tridiagonal matrix using the LU factorization computed by sgttrf. 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8*> \htmlonly 9*> Download ZGTTS2 + dependencies 10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgtts2.f"> 11*> [TGZ]</a> 12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgtts2.f"> 13*> [ZIP]</a> 14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgtts2.f"> 15*> [TXT]</a> 16*> \endhtmlonly 17* 18* Definition: 19* =========== 20* 21* SUBROUTINE ZGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB ) 22* 23* .. Scalar Arguments .. 24* INTEGER ITRANS, LDB, N, NRHS 25* .. 26* .. Array Arguments .. 27* INTEGER IPIV( * ) 28* COMPLEX*16 B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * ) 29* .. 30* 31* 32*> \par Purpose: 33* ============= 34*> 35*> \verbatim 36*> 37*> ZGTTS2 solves one of the systems of equations 38*> A * X = B, A**T * X = B, or A**H * X = B, 39*> with a tridiagonal matrix A using the LU factorization computed 40*> by ZGTTRF. 41*> \endverbatim 42* 43* Arguments: 44* ========== 45* 46*> \param[in] ITRANS 47*> \verbatim 48*> ITRANS is INTEGER 49*> Specifies the form of the system of equations. 50*> = 0: A * X = B (No transpose) 51*> = 1: A**T * X = B (Transpose) 52*> = 2: A**H * X = B (Conjugate transpose) 53*> \endverbatim 54*> 55*> \param[in] N 56*> \verbatim 57*> N is INTEGER 58*> The order of the matrix A. 59*> \endverbatim 60*> 61*> \param[in] NRHS 62*> \verbatim 63*> NRHS is INTEGER 64*> The number of right hand sides, i.e., the number of columns 65*> of the matrix B. NRHS >= 0. 66*> \endverbatim 67*> 68*> \param[in] DL 69*> \verbatim 70*> DL is COMPLEX*16 array, dimension (N-1) 71*> The (n-1) multipliers that define the matrix L from the 72*> LU factorization of A. 73*> \endverbatim 74*> 75*> \param[in] D 76*> \verbatim 77*> D is COMPLEX*16 array, dimension (N) 78*> The n diagonal elements of the upper triangular matrix U from 79*> the LU factorization of A. 80*> \endverbatim 81*> 82*> \param[in] DU 83*> \verbatim 84*> DU is COMPLEX*16 array, dimension (N-1) 85*> The (n-1) elements of the first super-diagonal of U. 86*> \endverbatim 87*> 88*> \param[in] DU2 89*> \verbatim 90*> DU2 is COMPLEX*16 array, dimension (N-2) 91*> The (n-2) elements of the second super-diagonal of U. 92*> \endverbatim 93*> 94*> \param[in] IPIV 95*> \verbatim 96*> IPIV is INTEGER array, dimension (N) 97*> The pivot indices; for 1 <= i <= n, row i of the matrix was 98*> interchanged with row IPIV(i). IPIV(i) will always be either 99*> i or i+1; IPIV(i) = i indicates a row interchange was not 100*> required. 101*> \endverbatim 102*> 103*> \param[in,out] B 104*> \verbatim 105*> B is COMPLEX*16 array, dimension (LDB,NRHS) 106*> On entry, the matrix of right hand side vectors B. 107*> On exit, B is overwritten by the solution vectors X. 108*> \endverbatim 109*> 110*> \param[in] LDB 111*> \verbatim 112*> LDB is INTEGER 113*> The leading dimension of the array B. LDB >= max(1,N). 114*> \endverbatim 115* 116* Authors: 117* ======== 118* 119*> \author Univ. of Tennessee 120*> \author Univ. of California Berkeley 121*> \author Univ. of Colorado Denver 122*> \author NAG Ltd. 123* 124*> \ingroup complex16GTcomputational 125* 126* ===================================================================== 127 SUBROUTINE ZGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB ) 128* 129* -- LAPACK computational routine -- 130* -- LAPACK is a software package provided by Univ. of Tennessee, -- 131* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 132* 133* .. Scalar Arguments .. 134 INTEGER ITRANS, LDB, N, NRHS 135* .. 136* .. Array Arguments .. 137 INTEGER IPIV( * ) 138 COMPLEX*16 B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * ) 139* .. 140* 141* ===================================================================== 142* 143* .. Local Scalars .. 144 INTEGER I, J 145 COMPLEX*16 TEMP 146* .. 147* .. Intrinsic Functions .. 148 INTRINSIC DCONJG 149* .. 150* .. Executable Statements .. 151* 152* Quick return if possible 153* 154 IF( N.EQ.0 .OR. NRHS.EQ.0 ) 155 $ RETURN 156* 157 IF( ITRANS.EQ.0 ) THEN 158* 159* Solve A*X = B using the LU factorization of A, 160* overwriting each right hand side vector with its solution. 161* 162 IF( NRHS.LE.1 ) THEN 163 J = 1 164 10 CONTINUE 165* 166* Solve L*x = b. 167* 168 DO 20 I = 1, N - 1 169 IF( IPIV( I ).EQ.I ) THEN 170 B( I+1, J ) = B( I+1, J ) - DL( I )*B( I, J ) 171 ELSE 172 TEMP = B( I, J ) 173 B( I, J ) = B( I+1, J ) 174 B( I+1, J ) = TEMP - DL( I )*B( I, J ) 175 END IF 176 20 CONTINUE 177* 178* Solve U*x = b. 179* 180 B( N, J ) = B( N, J ) / D( N ) 181 IF( N.GT.1 ) 182 $ B( N-1, J ) = ( B( N-1, J )-DU( N-1 )*B( N, J ) ) / 183 $ D( N-1 ) 184 DO 30 I = N - 2, 1, -1 185 B( I, J ) = ( B( I, J )-DU( I )*B( I+1, J )-DU2( I )* 186 $ B( I+2, J ) ) / D( I ) 187 30 CONTINUE 188 IF( J.LT.NRHS ) THEN 189 J = J + 1 190 GO TO 10 191 END IF 192 ELSE 193 DO 60 J = 1, NRHS 194* 195* Solve L*x = b. 196* 197 DO 40 I = 1, N - 1 198 IF( IPIV( I ).EQ.I ) THEN 199 B( I+1, J ) = B( I+1, J ) - DL( I )*B( I, J ) 200 ELSE 201 TEMP = B( I, J ) 202 B( I, J ) = B( I+1, J ) 203 B( I+1, J ) = TEMP - DL( I )*B( I, J ) 204 END IF 205 40 CONTINUE 206* 207* Solve U*x = b. 208* 209 B( N, J ) = B( N, J ) / D( N ) 210 IF( N.GT.1 ) 211 $ B( N-1, J ) = ( B( N-1, J )-DU( N-1 )*B( N, J ) ) / 212 $ D( N-1 ) 213 DO 50 I = N - 2, 1, -1 214 B( I, J ) = ( B( I, J )-DU( I )*B( I+1, J )-DU2( I )* 215 $ B( I+2, J ) ) / D( I ) 216 50 CONTINUE 217 60 CONTINUE 218 END IF 219 ELSE IF( ITRANS.EQ.1 ) THEN 220* 221* Solve A**T * X = B. 222* 223 IF( NRHS.LE.1 ) THEN 224 J = 1 225 70 CONTINUE 226* 227* Solve U**T * x = b. 228* 229 B( 1, J ) = B( 1, J ) / D( 1 ) 230 IF( N.GT.1 ) 231 $ B( 2, J ) = ( B( 2, J )-DU( 1 )*B( 1, J ) ) / D( 2 ) 232 DO 80 I = 3, N 233 B( I, J ) = ( B( I, J )-DU( I-1 )*B( I-1, J )-DU2( I-2 )* 234 $ B( I-2, J ) ) / D( I ) 235 80 CONTINUE 236* 237* Solve L**T * x = b. 238* 239 DO 90 I = N - 1, 1, -1 240 IF( IPIV( I ).EQ.I ) THEN 241 B( I, J ) = B( I, J ) - DL( I )*B( I+1, J ) 242 ELSE 243 TEMP = B( I+1, J ) 244 B( I+1, J ) = B( I, J ) - DL( I )*TEMP 245 B( I, J ) = TEMP 246 END IF 247 90 CONTINUE 248 IF( J.LT.NRHS ) THEN 249 J = J + 1 250 GO TO 70 251 END IF 252 ELSE 253 DO 120 J = 1, NRHS 254* 255* Solve U**T * x = b. 256* 257 B( 1, J ) = B( 1, J ) / D( 1 ) 258 IF( N.GT.1 ) 259 $ B( 2, J ) = ( B( 2, J )-DU( 1 )*B( 1, J ) ) / D( 2 ) 260 DO 100 I = 3, N 261 B( I, J ) = ( B( I, J )-DU( I-1 )*B( I-1, J )- 262 $ DU2( I-2 )*B( I-2, J ) ) / D( I ) 263 100 CONTINUE 264* 265* Solve L**T * x = b. 266* 267 DO 110 I = N - 1, 1, -1 268 IF( IPIV( I ).EQ.I ) THEN 269 B( I, J ) = B( I, J ) - DL( I )*B( I+1, J ) 270 ELSE 271 TEMP = B( I+1, J ) 272 B( I+1, J ) = B( I, J ) - DL( I )*TEMP 273 B( I, J ) = TEMP 274 END IF 275 110 CONTINUE 276 120 CONTINUE 277 END IF 278 ELSE 279* 280* Solve A**H * X = B. 281* 282 IF( NRHS.LE.1 ) THEN 283 J = 1 284 130 CONTINUE 285* 286* Solve U**H * x = b. 287* 288 B( 1, J ) = B( 1, J ) / DCONJG( D( 1 ) ) 289 IF( N.GT.1 ) 290 $ B( 2, J ) = ( B( 2, J )-DCONJG( DU( 1 ) )*B( 1, J ) ) / 291 $ DCONJG( D( 2 ) ) 292 DO 140 I = 3, N 293 B( I, J ) = ( B( I, J )-DCONJG( DU( I-1 ) )*B( I-1, J )- 294 $ DCONJG( DU2( I-2 ) )*B( I-2, J ) ) / 295 $ DCONJG( D( I ) ) 296 140 CONTINUE 297* 298* Solve L**H * x = b. 299* 300 DO 150 I = N - 1, 1, -1 301 IF( IPIV( I ).EQ.I ) THEN 302 B( I, J ) = B( I, J ) - DCONJG( DL( I ) )*B( I+1, J ) 303 ELSE 304 TEMP = B( I+1, J ) 305 B( I+1, J ) = B( I, J ) - DCONJG( DL( I ) )*TEMP 306 B( I, J ) = TEMP 307 END IF 308 150 CONTINUE 309 IF( J.LT.NRHS ) THEN 310 J = J + 1 311 GO TO 130 312 END IF 313 ELSE 314 DO 180 J = 1, NRHS 315* 316* Solve U**H * x = b. 317* 318 B( 1, J ) = B( 1, J ) / DCONJG( D( 1 ) ) 319 IF( N.GT.1 ) 320 $ B( 2, J ) = ( B( 2, J )-DCONJG( DU( 1 ) )*B( 1, J ) ) 321 $ / DCONJG( D( 2 ) ) 322 DO 160 I = 3, N 323 B( I, J ) = ( B( I, J )-DCONJG( DU( I-1 ) )* 324 $ B( I-1, J )-DCONJG( DU2( I-2 ) )* 325 $ B( I-2, J ) ) / DCONJG( D( I ) ) 326 160 CONTINUE 327* 328* Solve L**H * x = b. 329* 330 DO 170 I = N - 1, 1, -1 331 IF( IPIV( I ).EQ.I ) THEN 332 B( I, J ) = B( I, J ) - DCONJG( DL( I ) )* 333 $ B( I+1, J ) 334 ELSE 335 TEMP = B( I+1, J ) 336 B( I+1, J ) = B( I, J ) - DCONJG( DL( I ) )*TEMP 337 B( I, J ) = TEMP 338 END IF 339 170 CONTINUE 340 180 CONTINUE 341 END IF 342 END IF 343* 344* End of ZGTTS2 345* 346 END 347