LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
dgtts2.f
Go to the documentation of this file.
00001 *> \brief \b DGTTS2
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download DGTTS2 + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgtts2.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgtts2.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgtts2.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE DGTTS2( 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 *       DOUBLE PRECISION   B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * )
00029 *       ..
00030 *  
00031 *
00032 *> \par Purpose:
00033 *  =============
00034 *>
00035 *> \verbatim
00036 *>
00037 *> DGTTS2 solves one of the systems of equations
00038 *>    A*X = B  or  A**T*X = B,
00039 *> with a tridiagonal matrix A using the LU factorization computed
00040 *> by DGTTRF.
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**T* X = B  (Conjugate transpose = 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 doubleOTHERauxiliary
00127 *
00128 *  =====================================================================
00129       SUBROUTINE DGTTS2( 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       DOUBLE PRECISION   B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * )
00142 *     ..
00143 *
00144 *  =====================================================================
00145 *
00146 *     .. Local Scalars ..
00147       INTEGER            I, IP, J
00148       DOUBLE PRECISION   TEMP
00149 *     ..
00150 *     .. Executable Statements ..
00151 *
00152 *     Quick return if possible
00153 *
00154       IF( N.EQ.0 .OR. NRHS.EQ.0 )
00155      $   RETURN
00156 *
00157       IF( ITRANS.EQ.0 ) THEN
00158 *
00159 *        Solve A*X = B using the LU factorization of A,
00160 *        overwriting each right hand side vector with its solution.
00161 *
00162          IF( NRHS.LE.1 ) THEN
00163             J = 1
00164    10       CONTINUE
00165 *
00166 *           Solve L*x = b.
00167 *
00168             DO 20 I = 1, N - 1
00169                IP = IPIV( I )
00170                TEMP = B( I+1-IP+I, J ) - DL( I )*B( IP, J )
00171                B( I, J ) = B( IP, J )
00172                B( I+1, J ) = TEMP
00173    20       CONTINUE
00174 *
00175 *           Solve U*x = b.
00176 *
00177             B( N, J ) = B( N, J ) / D( N )
00178             IF( N.GT.1 )
00179      $         B( N-1, J ) = ( B( N-1, J )-DU( N-1 )*B( N, J ) ) /
00180      $                       D( N-1 )
00181             DO 30 I = N - 2, 1, -1
00182                B( I, J ) = ( B( I, J )-DU( I )*B( I+1, J )-DU2( I )*
00183      $                     B( I+2, J ) ) / D( I )
00184    30       CONTINUE
00185             IF( J.LT.NRHS ) THEN
00186                J = J + 1
00187                GO TO 10
00188             END IF
00189          ELSE
00190             DO 60 J = 1, NRHS
00191 *
00192 *              Solve L*x = b.
00193 *
00194                DO 40 I = 1, N - 1
00195                   IF( IPIV( I ).EQ.I ) THEN
00196                      B( I+1, J ) = B( I+1, J ) - DL( I )*B( I, J )
00197                   ELSE
00198                      TEMP = B( I, J )
00199                      B( I, J ) = B( I+1, J )
00200                      B( I+1, J ) = TEMP - DL( I )*B( I, J )
00201                   END IF
00202    40          CONTINUE
00203 *
00204 *              Solve U*x = b.
00205 *
00206                B( N, J ) = B( N, J ) / D( N )
00207                IF( N.GT.1 )
00208      $            B( N-1, J ) = ( B( N-1, J )-DU( N-1 )*B( N, J ) ) /
00209      $                          D( N-1 )
00210                DO 50 I = N - 2, 1, -1
00211                   B( I, J ) = ( B( I, J )-DU( I )*B( I+1, J )-DU2( I )*
00212      $                        B( I+2, J ) ) / D( I )
00213    50          CONTINUE
00214    60       CONTINUE
00215          END IF
00216       ELSE
00217 *
00218 *        Solve A**T * X = B.
00219 *
00220          IF( NRHS.LE.1 ) THEN
00221 *
00222 *           Solve U**T*x = b.
00223 *
00224             J = 1
00225    70       CONTINUE
00226             B( 1, J ) = B( 1, J ) / D( 1 )
00227             IF( N.GT.1 )
00228      $         B( 2, J ) = ( B( 2, J )-DU( 1 )*B( 1, J ) ) / D( 2 )
00229             DO 80 I = 3, N
00230                B( I, J ) = ( B( I, J )-DU( I-1 )*B( I-1, J )-DU2( I-2 )*
00231      $                     B( I-2, J ) ) / D( I )
00232    80       CONTINUE
00233 *
00234 *           Solve L**T*x = b.
00235 *
00236             DO 90 I = N - 1, 1, -1
00237                IP = IPIV( I )
00238                TEMP = B( I, J ) - DL( I )*B( I+1, J )
00239                B( I, J ) = B( IP, J )
00240                B( IP, J ) = TEMP
00241    90       CONTINUE
00242             IF( J.LT.NRHS ) THEN
00243                J = J + 1
00244                GO TO 70
00245             END IF
00246 *
00247          ELSE
00248             DO 120 J = 1, NRHS
00249 *
00250 *              Solve U**T*x = b.
00251 *
00252                B( 1, J ) = B( 1, J ) / D( 1 )
00253                IF( N.GT.1 )
00254      $            B( 2, J ) = ( B( 2, J )-DU( 1 )*B( 1, J ) ) / D( 2 )
00255                DO 100 I = 3, N
00256                   B( I, J ) = ( B( I, J )-DU( I-1 )*B( I-1, J )-
00257      $                        DU2( I-2 )*B( I-2, J ) ) / D( I )
00258   100          CONTINUE
00259                DO 110 I = N - 1, 1, -1
00260                   IF( IPIV( I ).EQ.I ) THEN
00261                      B( I, J ) = B( I, J ) - DL( I )*B( I+1, J )
00262                   ELSE
00263                      TEMP = B( I+1, J )
00264                      B( I+1, J ) = B( I, J ) - DL( I )*TEMP
00265                      B( I, J ) = TEMP
00266                   END IF
00267   110          CONTINUE
00268   120       CONTINUE
00269          END IF
00270       END IF
00271 *
00272 *     End of DGTTS2
00273 *
00274       END
 All Files Functions