LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
zgtts2.f
Go to the documentation of this file.
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
 All Files Functions