LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
cgtsv.f
Go to the documentation of this file.
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 *> \date September 2012
121 *
122 *> \ingroup complexGTsolve
123 *
124 * =====================================================================
125  SUBROUTINE cgtsv( N, NRHS, DL, D, DU, B, LDB, INFO )
126 *
127 * -- LAPACK driver routine (version 3.4.2) --
128 * -- LAPACK is a software package provided by Univ. of Tennessee, --
129 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
130 * September 2012
131 *
132 * .. Scalar Arguments ..
133  INTEGER info, ldb, n, nrhs
134 * ..
135 * .. Array Arguments ..
136  COMPLEX b( ldb, * ), d( * ), dl( * ), du( * )
137 * ..
138 *
139 * =====================================================================
140 *
141 * .. Parameters ..
142  COMPLEX zero
143  parameter( zero = ( 0.0e+0, 0.0e+0 ) )
144 * ..
145 * .. Local Scalars ..
146  INTEGER j, k
147  COMPLEX mult, temp, zdum
148 * ..
149 * .. Intrinsic Functions ..
150  INTRINSIC abs, aimag, max, real
151 * ..
152 * .. External Subroutines ..
153  EXTERNAL xerbla
154 * ..
155 * .. Statement Functions ..
156  REAL cabs1
157 * ..
158 * .. Statement Function definitions ..
159  cabs1( zdum ) = abs( REAL( ZDUM ) ) + abs( aimag( zdum ) )
160 * ..
161 * .. Executable Statements ..
162 *
163  info = 0
164  IF( n.LT.0 ) THEN
165  info = -1
166  ELSE IF( nrhs.LT.0 ) THEN
167  info = -2
168  ELSE IF( ldb.LT.max( 1, n ) ) THEN
169  info = -7
170  END IF
171  IF( info.NE.0 ) THEN
172  CALL xerbla( 'CGTSV ', -info )
173  return
174  END IF
175 *
176  IF( n.EQ.0 )
177  $ return
178 *
179  DO 30 k = 1, n - 1
180  IF( dl( k ).EQ.zero ) THEN
181 *
182 * Subdiagonal is zero, no elimination is required.
183 *
184  IF( d( k ).EQ.zero ) THEN
185 *
186 * Diagonal is zero: set INFO = K and return; a unique
187 * solution can not be found.
188 *
189  info = k
190  return
191  END IF
192  ELSE IF( cabs1( d( k ) ).GE.cabs1( dl( k ) ) ) THEN
193 *
194 * No row interchange required
195 *
196  mult = dl( k ) / d( k )
197  d( k+1 ) = d( k+1 ) - mult*du( k )
198  DO 10 j = 1, nrhs
199  b( k+1, j ) = b( k+1, j ) - mult*b( k, j )
200  10 continue
201  IF( k.LT.( n-1 ) )
202  $ dl( k ) = zero
203  ELSE
204 *
205 * Interchange rows K and K+1
206 *
207  mult = d( k ) / dl( k )
208  d( k ) = dl( k )
209  temp = d( k+1 )
210  d( k+1 ) = du( k ) - mult*temp
211  IF( k.LT.( n-1 ) ) THEN
212  dl( k ) = du( k+1 )
213  du( k+1 ) = -mult*dl( k )
214  END IF
215  du( k ) = temp
216  DO 20 j = 1, nrhs
217  temp = b( k, j )
218  b( k, j ) = b( k+1, j )
219  b( k+1, j ) = temp - mult*b( k+1, j )
220  20 continue
221  END IF
222  30 continue
223  IF( d( n ).EQ.zero ) THEN
224  info = n
225  return
226  END IF
227 *
228 * Back solve with the matrix U from the factorization.
229 *
230  DO 50 j = 1, nrhs
231  b( n, j ) = b( n, j ) / d( n )
232  IF( n.GT.1 )
233  $ b( n-1, j ) = ( b( n-1, j )-du( n-1 )*b( n, j ) ) / d( n-1 )
234  DO 40 k = n - 2, 1, -1
235  b( k, j ) = ( b( k, j )-du( k )*b( k+1, j )-dl( k )*
236  $ b( k+2, j ) ) / d( k )
237  40 continue
238  50 continue
239 *
240  return
241 *
242 * End of CGTSV
243 *
244  END