001:       SUBROUTINE CGTSV( N, NRHS, DL, D, DU, B, LDB, INFO )
002: *
003: *  -- LAPACK routine (version 3.2) --
004: *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
005: *     November 2006
006: *
007: *     .. Scalar Arguments ..
008:       INTEGER            INFO, LDB, N, NRHS
009: *     ..
010: *     .. Array Arguments ..
011:       COMPLEX            B( LDB, * ), D( * ), DL( * ), DU( * )
012: *     ..
013: *
014: *  Purpose
015: *  =======
016: *
017: *  CGTSV  solves the equation
018: *
019: *     A*X = B,
020: *
021: *  where A is an N-by-N tridiagonal matrix, by Gaussian elimination with
022: *  partial pivoting.
023: *
024: *  Note that the equation  A'*X = B  may be solved by interchanging the
025: *  order of the arguments DU and DL.
026: *
027: *  Arguments
028: *  =========
029: *
030: *  N       (input) INTEGER
031: *          The order of the matrix A.  N >= 0.
032: *
033: *  NRHS    (input) INTEGER
034: *          The number of right hand sides, i.e., the number of columns
035: *          of the matrix B.  NRHS >= 0.
036: *
037: *  DL      (input/output) COMPLEX array, dimension (N-1)
038: *          On entry, DL must contain the (n-1) subdiagonal elements of
039: *          A.
040: *          On exit, DL is overwritten by the (n-2) elements of the
041: *          second superdiagonal of the upper triangular matrix U from
042: *          the LU factorization of A, in DL(1), ..., DL(n-2).
043: *
044: *  D       (input/output) COMPLEX array, dimension (N)
045: *          On entry, D must contain the diagonal elements of A.
046: *          On exit, D is overwritten by the n diagonal elements of U.
047: *
048: *  DU      (input/output) COMPLEX array, dimension (N-1)
049: *          On entry, DU must contain the (n-1) superdiagonal elements
050: *          of A.
051: *          On exit, DU is overwritten by the (n-1) elements of the first
052: *          superdiagonal of U.
053: *
054: *  B       (input/output) COMPLEX array, dimension (LDB,NRHS)
055: *          On entry, the N-by-NRHS right hand side matrix B.
056: *          On exit, if INFO = 0, the N-by-NRHS solution matrix X.
057: *
058: *  LDB     (input) INTEGER
059: *          The leading dimension of the array B.  LDB >= max(1,N).
060: *
061: *  INFO    (output) INTEGER
062: *          = 0:  successful exit
063: *          < 0:  if INFO = -i, the i-th argument had an illegal value
064: *          > 0:  if INFO = i, U(i,i) is exactly zero, and the solution
065: *                has not been computed.  The factorization has not been
066: *                completed unless i = N.
067: *
068: *  =====================================================================
069: *
070: *     .. Parameters ..
071:       COMPLEX            ZERO
072:       PARAMETER          ( ZERO = ( 0.0E+0, 0.0E+0 ) )
073: *     ..
074: *     .. Local Scalars ..
075:       INTEGER            J, K
076:       COMPLEX            MULT, TEMP, ZDUM
077: *     ..
078: *     .. Intrinsic Functions ..
079:       INTRINSIC          ABS, AIMAG, MAX, REAL
080: *     ..
081: *     .. External Subroutines ..
082:       EXTERNAL           XERBLA
083: *     ..
084: *     .. Statement Functions ..
085:       REAL               CABS1
086: *     ..
087: *     .. Statement Function definitions ..
088:       CABS1( ZDUM ) = ABS( REAL( ZDUM ) ) + ABS( AIMAG( ZDUM ) )
089: *     ..
090: *     .. Executable Statements ..
091: *
092:       INFO = 0
093:       IF( N.LT.0 ) THEN
094:          INFO = -1
095:       ELSE IF( NRHS.LT.0 ) THEN
096:          INFO = -2
097:       ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
098:          INFO = -7
099:       END IF
100:       IF( INFO.NE.0 ) THEN
101:          CALL XERBLA( 'CGTSV ', -INFO )
102:          RETURN
103:       END IF
104: *
105:       IF( N.EQ.0 )
106:      $   RETURN
107: *
108:       DO 30 K = 1, N - 1
109:          IF( DL( K ).EQ.ZERO ) THEN
110: *
111: *           Subdiagonal is zero, no elimination is required.
112: *
113:             IF( D( K ).EQ.ZERO ) THEN
114: *
115: *              Diagonal is zero: set INFO = K and return; a unique
116: *              solution can not be found.
117: *
118:                INFO = K
119:                RETURN
120:             END IF
121:          ELSE IF( CABS1( D( K ) ).GE.CABS1( DL( K ) ) ) THEN
122: *
123: *           No row interchange required
124: *
125:             MULT = DL( K ) / D( K )
126:             D( K+1 ) = D( K+1 ) - MULT*DU( K )
127:             DO 10 J = 1, NRHS
128:                B( K+1, J ) = B( K+1, J ) - MULT*B( K, J )
129:    10       CONTINUE
130:             IF( K.LT.( N-1 ) )
131:      $         DL( K ) = ZERO
132:          ELSE
133: *
134: *           Interchange rows K and K+1
135: *
136:             MULT = D( K ) / DL( K )
137:             D( K ) = DL( K )
138:             TEMP = D( K+1 )
139:             D( K+1 ) = DU( K ) - MULT*TEMP
140:             IF( K.LT.( N-1 ) ) THEN
141:                DL( K ) = DU( K+1 )
142:                DU( K+1 ) = -MULT*DL( K )
143:             END IF
144:             DU( K ) = TEMP
145:             DO 20 J = 1, NRHS
146:                TEMP = B( K, J )
147:                B( K, J ) = B( K+1, J )
148:                B( K+1, J ) = TEMP - MULT*B( K+1, J )
149:    20       CONTINUE
150:          END IF
151:    30 CONTINUE
152:       IF( D( N ).EQ.ZERO ) THEN
153:          INFO = N
154:          RETURN
155:       END IF
156: *
157: *     Back solve with the matrix U from the factorization.
158: *
159:       DO 50 J = 1, NRHS
160:          B( N, J ) = B( N, J ) / D( N )
161:          IF( N.GT.1 )
162:      $      B( N-1, J ) = ( B( N-1, J )-DU( N-1 )*B( N, J ) ) / D( N-1 )
163:          DO 40 K = N - 2, 1, -1
164:             B( K, J ) = ( B( K, J )-DU( K )*B( K+1, J )-DL( K )*
165:      $                  B( K+2, J ) ) / D( K )
166:    40    CONTINUE
167:    50 CONTINUE
168: *
169:       RETURN
170: *
171: *     End of CGTSV
172: *
173:       END
174: