1*> \brief <b> CGTSV computes the solution to system of linear equations A * X = B for GT matrices </b>
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download CGTSV + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgtsv.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cgtsv.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgtsv.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE CGTSV( N, NRHS, DL, D, DU, B, LDB, INFO )
22*
23*       .. Scalar Arguments ..
24*       INTEGER            INFO, LDB, N, NRHS
25*       ..
26*       .. Array Arguments ..
27*       COMPLEX            B( LDB, * ), D( * ), DL( * ), DU( * )
28*       ..
29*
30*
31*> \par Purpose:
32*  =============
33*>
34*> \verbatim
35*>
36*> CGTSV  solves the equation
37*>
38*>    A*X = B,
39*>
40*> where A is an N-by-N tridiagonal matrix, by Gaussian elimination with
41*> partial pivoting.
42*>
43*> Note that the equation  A**T *X = B  may be solved by interchanging the
44*> order of the arguments DU and DL.
45*> \endverbatim
46*
47*  Arguments:
48*  ==========
49*
50*> \param[in] N
51*> \verbatim
52*>          N is INTEGER
53*>          The order of the matrix A.  N >= 0.
54*> \endverbatim
55*>
56*> \param[in] NRHS
57*> \verbatim
58*>          NRHS is INTEGER
59*>          The number of right hand sides, i.e., the number of columns
60*>          of the matrix B.  NRHS >= 0.
61*> \endverbatim
62*>
63*> \param[in,out] DL
64*> \verbatim
65*>          DL is COMPLEX array, dimension (N-1)
66*>          On entry, DL must contain the (n-1) subdiagonal elements of
67*>          A.
68*>          On exit, DL is overwritten by the (n-2) elements of the
69*>          second superdiagonal of the upper triangular matrix U from
70*>          the LU factorization of A, in DL(1), ..., DL(n-2).
71*> \endverbatim
72*>
73*> \param[in,out] D
74*> \verbatim
75*>          D is COMPLEX array, dimension (N)
76*>          On entry, D must contain the diagonal elements of A.
77*>          On exit, D is overwritten by the n diagonal elements of U.
78*> \endverbatim
79*>
80*> \param[in,out] DU
81*> \verbatim
82*>          DU is COMPLEX array, dimension (N-1)
83*>          On entry, DU must contain the (n-1) superdiagonal elements
84*>          of A.
85*>          On exit, DU is overwritten by the (n-1) elements of the first
86*>          superdiagonal of U.
87*> \endverbatim
88*>
89*> \param[in,out] B
90*> \verbatim
91*>          B is COMPLEX array, dimension (LDB,NRHS)
92*>          On entry, the N-by-NRHS right hand side matrix B.
93*>          On exit, if INFO = 0, the N-by-NRHS solution matrix X.
94*> \endverbatim
95*>
96*> \param[in] LDB
97*> \verbatim
98*>          LDB is INTEGER
99*>          The leading dimension of the array B.  LDB >= max(1,N).
100*> \endverbatim
101*>
102*> \param[out] INFO
103*> \verbatim
104*>          INFO is INTEGER
105*>          = 0:  successful exit
106*>          < 0:  if INFO = -i, the i-th argument had an illegal value
107*>          > 0:  if INFO = i, U(i,i) is exactly zero, and the solution
108*>                has not been computed.  The factorization has not been
109*>                completed unless i = N.
110*> \endverbatim
111*
112*  Authors:
113*  ========
114*
115*> \author Univ. of Tennessee
116*> \author Univ. of California Berkeley
117*> \author Univ. of Colorado Denver
118*> \author NAG Ltd.
119*
120*> \ingroup complexGTsolve
121*
122*  =====================================================================
123      SUBROUTINE CGTSV( N, NRHS, DL, D, DU, B, LDB, INFO )
124*
125*  -- LAPACK driver routine --
126*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
127*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
128*
129*     .. Scalar Arguments ..
130      INTEGER            INFO, LDB, N, NRHS
131*     ..
132*     .. Array Arguments ..
133      COMPLEX            B( LDB, * ), D( * ), DL( * ), DU( * )
134*     ..
135*
136*  =====================================================================
137*
138*     .. Parameters ..
139      COMPLEX            ZERO
140      PARAMETER          ( ZERO = ( 0.0E+0, 0.0E+0 ) )
141*     ..
142*     .. Local Scalars ..
143      INTEGER            J, K
144      COMPLEX            MULT, TEMP, ZDUM
145*     ..
146*     .. Intrinsic Functions ..
147      INTRINSIC          ABS, AIMAG, MAX, REAL
148*     ..
149*     .. External Subroutines ..
150      EXTERNAL           XERBLA
151*     ..
152*     .. Statement Functions ..
153      REAL               CABS1
154*     ..
155*     .. Statement Function definitions ..
156      CABS1( ZDUM ) = ABS( REAL( ZDUM ) ) + ABS( AIMAG( ZDUM ) )
157*     ..
158*     .. Executable Statements ..
159*
160      INFO = 0
161      IF( N.LT.0 ) THEN
162         INFO = -1
163      ELSE IF( NRHS.LT.0 ) THEN
164         INFO = -2
165      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
166         INFO = -7
167      END IF
168      IF( INFO.NE.0 ) THEN
169         CALL XERBLA( 'CGTSV ', -INFO )
170         RETURN
171      END IF
172*
173      IF( N.EQ.0 )
174     $   RETURN
175*
176      DO 30 K = 1, N - 1
177         IF( DL( K ).EQ.ZERO ) THEN
178*
179*           Subdiagonal is zero, no elimination is required.
180*
181            IF( D( K ).EQ.ZERO ) THEN
182*
183*              Diagonal is zero: set INFO = K and return; a unique
184*              solution can not be found.
185*
186               INFO = K
187               RETURN
188            END IF
189         ELSE IF( CABS1( D( K ) ).GE.CABS1( DL( K ) ) ) THEN
190*
191*           No row interchange required
192*
193            MULT = DL( K ) / D( K )
194            D( K+1 ) = D( K+1 ) - MULT*DU( K )
195            DO 10 J = 1, NRHS
196               B( K+1, J ) = B( K+1, J ) - MULT*B( K, J )
197   10       CONTINUE
198            IF( K.LT.( N-1 ) )
199     $         DL( K ) = ZERO
200         ELSE
201*
202*           Interchange rows K and K+1
203*
204            MULT = D( K ) / DL( K )
205            D( K ) = DL( K )
206            TEMP = D( K+1 )
207            D( K+1 ) = DU( K ) - MULT*TEMP
208            IF( K.LT.( N-1 ) ) THEN
209               DL( K ) = DU( K+1 )
210               DU( K+1 ) = -MULT*DL( K )
211            END IF
212            DU( K ) = TEMP
213            DO 20 J = 1, NRHS
214               TEMP = B( K, J )
215               B( K, J ) = B( K+1, J )
216               B( K+1, J ) = TEMP - MULT*B( K+1, J )
217   20       CONTINUE
218         END IF
219   30 CONTINUE
220      IF( D( N ).EQ.ZERO ) THEN
221         INFO = N
222         RETURN
223      END IF
224*
225*     Back solve with the matrix U from the factorization.
226*
227      DO 50 J = 1, NRHS
228         B( N, J ) = B( N, J ) / D( N )
229         IF( N.GT.1 )
230     $      B( N-1, J ) = ( B( N-1, J )-DU( N-1 )*B( N, J ) ) / D( N-1 )
231         DO 40 K = N - 2, 1, -1
232            B( K, J ) = ( B( K, J )-DU( K )*B( K+1, J )-DL( K )*
233     $                  B( K+2, J ) ) / D( K )
234   40    CONTINUE
235   50 CONTINUE
236*
237      RETURN
238*
239*     End of CGTSV
240*
241      END
242