LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
cgtsv.f
Go to the documentation of this file.
00001 *> \brief \b CGTSV
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download CGTSV + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgtsv.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cgtsv.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgtsv.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE CGTSV( N, NRHS, DL, D, DU, B, LDB, INFO )
00022 * 
00023 *       .. Scalar Arguments ..
00024 *       INTEGER            INFO, LDB, N, NRHS
00025 *       ..
00026 *       .. Array Arguments ..
00027 *       COMPLEX            B( LDB, * ), D( * ), DL( * ), DU( * )
00028 *       ..
00029 *  
00030 *
00031 *> \par Purpose:
00032 *  =============
00033 *>
00034 *> \verbatim
00035 *>
00036 *> CGTSV  solves the equation
00037 *>
00038 *>    A*X = B,
00039 *>
00040 *> where A is an N-by-N tridiagonal matrix, by Gaussian elimination with
00041 *> partial pivoting.
00042 *>
00043 *> Note that the equation  A**T *X = B  may be solved by interchanging the
00044 *> order of the arguments DU and DL.
00045 *> \endverbatim
00046 *
00047 *  Arguments:
00048 *  ==========
00049 *
00050 *> \param[in] N
00051 *> \verbatim
00052 *>          N is INTEGER
00053 *>          The order of the matrix A.  N >= 0.
00054 *> \endverbatim
00055 *>
00056 *> \param[in] NRHS
00057 *> \verbatim
00058 *>          NRHS is INTEGER
00059 *>          The number of right hand sides, i.e., the number of columns
00060 *>          of the matrix B.  NRHS >= 0.
00061 *> \endverbatim
00062 *>
00063 *> \param[in,out] DL
00064 *> \verbatim
00065 *>          DL is COMPLEX array, dimension (N-1)
00066 *>          On entry, DL must contain the (n-1) subdiagonal elements of
00067 *>          A.
00068 *>          On exit, DL is overwritten by the (n-2) elements of the
00069 *>          second superdiagonal of the upper triangular matrix U from
00070 *>          the LU factorization of A, in DL(1), ..., DL(n-2).
00071 *> \endverbatim
00072 *>
00073 *> \param[in,out] D
00074 *> \verbatim
00075 *>          D is COMPLEX array, dimension (N)
00076 *>          On entry, D must contain the diagonal elements of A.
00077 *>          On exit, D is overwritten by the n diagonal elements of U.
00078 *> \endverbatim
00079 *>
00080 *> \param[in,out] DU
00081 *> \verbatim
00082 *>          DU is COMPLEX array, dimension (N-1)
00083 *>          On entry, DU must contain the (n-1) superdiagonal elements
00084 *>          of A.
00085 *>          On exit, DU is overwritten by the (n-1) elements of the first
00086 *>          superdiagonal of U.
00087 *> \endverbatim
00088 *>
00089 *> \param[in,out] B
00090 *> \verbatim
00091 *>          B is COMPLEX array, dimension (LDB,NRHS)
00092 *>          On entry, the N-by-NRHS right hand side matrix B.
00093 *>          On exit, if INFO = 0, the N-by-NRHS solution matrix X.
00094 *> \endverbatim
00095 *>
00096 *> \param[in] LDB
00097 *> \verbatim
00098 *>          LDB is INTEGER
00099 *>          The leading dimension of the array B.  LDB >= max(1,N).
00100 *> \endverbatim
00101 *>
00102 *> \param[out] INFO
00103 *> \verbatim
00104 *>          INFO is INTEGER
00105 *>          = 0:  successful exit
00106 *>          < 0:  if INFO = -i, the i-th argument had an illegal value
00107 *>          > 0:  if INFO = i, U(i,i) is exactly zero, and the solution
00108 *>                has not been computed.  The factorization has not been
00109 *>                completed unless i = N.
00110 *> \endverbatim
00111 *
00112 *  Authors:
00113 *  ========
00114 *
00115 *> \author Univ. of Tennessee 
00116 *> \author Univ. of California Berkeley 
00117 *> \author Univ. of Colorado Denver 
00118 *> \author NAG Ltd. 
00119 *
00120 *> \date November 2011
00121 *
00122 *> \ingroup complexOTHERcomputational
00123 *
00124 *  =====================================================================
00125       SUBROUTINE CGTSV( N, NRHS, DL, D, DU, B, LDB, INFO )
00126 *
00127 *  -- LAPACK computational routine (version 3.4.0) --
00128 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00129 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00130 *     November 2011
00131 *
00132 *     .. Scalar Arguments ..
00133       INTEGER            INFO, LDB, N, NRHS
00134 *     ..
00135 *     .. Array Arguments ..
00136       COMPLEX            B( LDB, * ), D( * ), DL( * ), DU( * )
00137 *     ..
00138 *
00139 *  =====================================================================
00140 *
00141 *     .. Parameters ..
00142       COMPLEX            ZERO
00143       PARAMETER          ( ZERO = ( 0.0E+0, 0.0E+0 ) )
00144 *     ..
00145 *     .. Local Scalars ..
00146       INTEGER            J, K
00147       COMPLEX            MULT, TEMP, ZDUM
00148 *     ..
00149 *     .. Intrinsic Functions ..
00150       INTRINSIC          ABS, AIMAG, MAX, REAL
00151 *     ..
00152 *     .. External Subroutines ..
00153       EXTERNAL           XERBLA
00154 *     ..
00155 *     .. Statement Functions ..
00156       REAL               CABS1
00157 *     ..
00158 *     .. Statement Function definitions ..
00159       CABS1( ZDUM ) = ABS( REAL( ZDUM ) ) + ABS( AIMAG( ZDUM ) )
00160 *     ..
00161 *     .. Executable Statements ..
00162 *
00163       INFO = 0
00164       IF( N.LT.0 ) THEN
00165          INFO = -1
00166       ELSE IF( NRHS.LT.0 ) THEN
00167          INFO = -2
00168       ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
00169          INFO = -7
00170       END IF
00171       IF( INFO.NE.0 ) THEN
00172          CALL XERBLA( 'CGTSV ', -INFO )
00173          RETURN
00174       END IF
00175 *
00176       IF( N.EQ.0 )
00177      $   RETURN
00178 *
00179       DO 30 K = 1, N - 1
00180          IF( DL( K ).EQ.ZERO ) THEN
00181 *
00182 *           Subdiagonal is zero, no elimination is required.
00183 *
00184             IF( D( K ).EQ.ZERO ) THEN
00185 *
00186 *              Diagonal is zero: set INFO = K and return; a unique
00187 *              solution can not be found.
00188 *
00189                INFO = K
00190                RETURN
00191             END IF
00192          ELSE IF( CABS1( D( K ) ).GE.CABS1( DL( K ) ) ) THEN
00193 *
00194 *           No row interchange required
00195 *
00196             MULT = DL( K ) / D( K )
00197             D( K+1 ) = D( K+1 ) - MULT*DU( K )
00198             DO 10 J = 1, NRHS
00199                B( K+1, J ) = B( K+1, J ) - MULT*B( K, J )
00200    10       CONTINUE
00201             IF( K.LT.( N-1 ) )
00202      $         DL( K ) = ZERO
00203          ELSE
00204 *
00205 *           Interchange rows K and K+1
00206 *
00207             MULT = D( K ) / DL( K )
00208             D( K ) = DL( K )
00209             TEMP = D( K+1 )
00210             D( K+1 ) = DU( K ) - MULT*TEMP
00211             IF( K.LT.( N-1 ) ) THEN
00212                DL( K ) = DU( K+1 )
00213                DU( K+1 ) = -MULT*DL( K )
00214             END IF
00215             DU( K ) = TEMP
00216             DO 20 J = 1, NRHS
00217                TEMP = B( K, J )
00218                B( K, J ) = B( K+1, J )
00219                B( K+1, J ) = TEMP - MULT*B( K+1, J )
00220    20       CONTINUE
00221          END IF
00222    30 CONTINUE
00223       IF( D( N ).EQ.ZERO ) THEN
00224          INFO = N
00225          RETURN
00226       END IF
00227 *
00228 *     Back solve with the matrix U from the factorization.
00229 *
00230       DO 50 J = 1, NRHS
00231          B( N, J ) = B( N, J ) / D( N )
00232          IF( N.GT.1 )
00233      $      B( N-1, J ) = ( B( N-1, J )-DU( N-1 )*B( N, J ) ) / D( N-1 )
00234          DO 40 K = N - 2, 1, -1
00235             B( K, J ) = ( B( K, J )-DU( K )*B( K+1, J )-DL( K )*
00236      $                  B( K+2, J ) ) / D( K )
00237    40    CONTINUE
00238    50 CONTINUE
00239 *
00240       RETURN
00241 *
00242 *     End of CGTSV
00243 *
00244       END
 All Files Functions