LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
cgtts2.f
Go to the documentation of this file.
1*> \brief \b CGTTS2 solves a system of linear equations with a tridiagonal matrix using the LU factorization computed by sgttrf.
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> Download CGTTS2 + dependencies
9*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgtts2.f">
10*> [TGZ]</a>
11*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cgtts2.f">
12*> [ZIP]</a>
13*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgtts2.f">
14*> [TXT]</a>
15*
16* Definition:
17* ===========
18*
19* SUBROUTINE CGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB )
20*
21* .. Scalar Arguments ..
22* INTEGER ITRANS, LDB, N, NRHS
23* ..
24* .. Array Arguments ..
25* INTEGER IPIV( * )
26* COMPLEX B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * )
27* ..
28*
29*
30*> \par Purpose:
31* =============
32*>
33*> \verbatim
34*>
35*> CGTTS2 solves one of the systems of equations
36*> A * X = B, A**T * X = B, or A**H * X = B,
37*> with a tridiagonal matrix A using the LU factorization computed
38*> by CGTTRF.
39*> \endverbatim
40*
41* Arguments:
42* ==========
43*
44*> \param[in] ITRANS
45*> \verbatim
46*> ITRANS is INTEGER
47*> Specifies the form of the system of equations.
48*> = 0: A * X = B (No transpose)
49*> = 1: A**T * X = B (Transpose)
50*> = 2: A**H * X = B (Conjugate transpose)
51*> \endverbatim
52*>
53*> \param[in] N
54*> \verbatim
55*> N is INTEGER
56*> The order of the matrix A.
57*> \endverbatim
58*>
59*> \param[in] NRHS
60*> \verbatim
61*> NRHS is INTEGER
62*> The number of right hand sides, i.e., the number of columns
63*> of the matrix B. NRHS >= 0.
64*> \endverbatim
65*>
66*> \param[in] DL
67*> \verbatim
68*> DL is COMPLEX array, dimension (N-1)
69*> The (n-1) multipliers that define the matrix L from the
70*> LU factorization of A.
71*> \endverbatim
72*>
73*> \param[in] D
74*> \verbatim
75*> D is COMPLEX array, dimension (N)
76*> The n diagonal elements of the upper triangular matrix U from
77*> the LU factorization of A.
78*> \endverbatim
79*>
80*> \param[in] DU
81*> \verbatim
82*> DU is COMPLEX array, dimension (N-1)
83*> The (n-1) elements of the first super-diagonal of U.
84*> \endverbatim
85*>
86*> \param[in] DU2
87*> \verbatim
88*> DU2 is COMPLEX array, dimension (N-2)
89*> The (n-2) elements of the second super-diagonal of U.
90*> \endverbatim
91*>
92*> \param[in] IPIV
93*> \verbatim
94*> IPIV is INTEGER array, dimension (N)
95*> The pivot indices; for 1 <= i <= n, row i of the matrix was
96*> interchanged with row IPIV(i). IPIV(i) will always be either
97*> i or i+1; IPIV(i) = i indicates a row interchange was not
98*> required.
99*> \endverbatim
100*>
101*> \param[in,out] B
102*> \verbatim
103*> B is COMPLEX array, dimension (LDB,NRHS)
104*> On entry, the matrix of right hand side vectors B.
105*> On exit, B is overwritten by the solution vectors X.
106*> \endverbatim
107*>
108*> \param[in] LDB
109*> \verbatim
110*> LDB is INTEGER
111*> The leading dimension of the array B. LDB >= max(1,N).
112*> \endverbatim
113*
114* Authors:
115* ========
116*
117*> \author Univ. of Tennessee
118*> \author Univ. of California Berkeley
119*> \author Univ. of Colorado Denver
120*> \author NAG Ltd.
121*
122*> \ingroup gtts2
123*
124* =====================================================================
125 SUBROUTINE cgtts2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B,
126 $ LDB )
127*
128* -- LAPACK computational routine --
129* -- LAPACK is a software package provided by Univ. of Tennessee, --
130* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
131*
132* .. Scalar Arguments ..
133 INTEGER ITRANS, LDB, N, NRHS
134* ..
135* .. Array Arguments ..
136 INTEGER IPIV( * )
137 COMPLEX B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * )
138* ..
139*
140* =====================================================================
141*
142* .. Local Scalars ..
143 INTEGER I, J
144 COMPLEX TEMP
145* ..
146* .. Intrinsic Functions ..
147 INTRINSIC conjg
148* ..
149* .. Executable Statements ..
150*
151* Quick return if possible
152*
153 IF( n.EQ.0 .OR. nrhs.EQ.0 )
154 $ RETURN
155*
156 IF( itrans.EQ.0 ) THEN
157*
158* Solve A*X = B using the LU factorization of A,
159* overwriting each right hand side vector with its solution.
160*
161 IF( nrhs.LE.1 ) THEN
162 j = 1
163 10 CONTINUE
164*
165* Solve L*x = b.
166*
167 DO 20 i = 1, n - 1
168 IF( ipiv( i ).EQ.i ) THEN
169 b( i+1, j ) = b( i+1, j ) - dl( i )*b( i, j )
170 ELSE
171 temp = b( i, j )
172 b( i, j ) = b( i+1, j )
173 b( i+1, j ) = temp - dl( i )*b( i, j )
174 END IF
175 20 CONTINUE
176*
177* Solve U*x = b.
178*
179 b( n, j ) = b( n, j ) / d( n )
180 IF( n.GT.1 )
181 $ b( n-1, j ) = ( b( n-1, j )-du( n-1 )*b( n, j ) ) /
182 $ d( n-1 )
183 DO 30 i = n - 2, 1, -1
184 b( i, j ) = ( b( i, j )-du( i )*b( i+1, j )-du2( i )*
185 $ b( i+2, j ) ) / d( i )
186 30 CONTINUE
187 IF( j.LT.nrhs ) THEN
188 j = j + 1
189 GO TO 10
190 END IF
191 ELSE
192 DO 60 j = 1, nrhs
193*
194* Solve L*x = b.
195*
196 DO 40 i = 1, n - 1
197 IF( ipiv( i ).EQ.i ) THEN
198 b( i+1, j ) = b( i+1, j ) - dl( i )*b( i, j )
199 ELSE
200 temp = b( i, j )
201 b( i, j ) = b( i+1, j )
202 b( i+1, j ) = temp - dl( i )*b( i, j )
203 END IF
204 40 CONTINUE
205*
206* Solve U*x = b.
207*
208 b( n, j ) = b( n, j ) / d( n )
209 IF( n.GT.1 )
210 $ b( n-1, j ) = ( b( n-1, j )-du( n-1 )*b( n, j ) ) /
211 $ d( n-1 )
212 DO 50 i = n - 2, 1, -1
213 b( i, j ) = ( b( i, j )-du( i )*b( i+1, j )-du2( i )*
214 $ b( i+2, j ) ) / d( i )
215 50 CONTINUE
216 60 CONTINUE
217 END IF
218 ELSE IF( itrans.EQ.1 ) THEN
219*
220* Solve A**T * X = B.
221*
222 IF( nrhs.LE.1 ) THEN
223 j = 1
224 70 CONTINUE
225*
226* Solve U**T * x = b.
227*
228 b( 1, j ) = b( 1, j ) / d( 1 )
229 IF( n.GT.1 )
230 $ b( 2, j ) = ( b( 2, j )-du( 1 )*b( 1, j ) ) / d( 2 )
231 DO 80 i = 3, n
232 b( i, j ) = ( b( i, j )-du( i-1 )*b( i-1, j )-du2( i-2 )*
233 $ b( i-2, j ) ) / d( i )
234 80 CONTINUE
235*
236* Solve L**T * x = b.
237*
238 DO 90 i = n - 1, 1, -1
239 IF( ipiv( i ).EQ.i ) THEN
240 b( i, j ) = b( i, j ) - dl( i )*b( i+1, j )
241 ELSE
242 temp = b( i+1, j )
243 b( i+1, j ) = b( i, j ) - dl( i )*temp
244 b( i, j ) = temp
245 END IF
246 90 CONTINUE
247 IF( j.LT.nrhs ) THEN
248 j = j + 1
249 GO TO 70
250 END IF
251 ELSE
252 DO 120 j = 1, nrhs
253*
254* Solve U**T * x = b.
255*
256 b( 1, j ) = b( 1, j ) / d( 1 )
257 IF( n.GT.1 )
258 $ b( 2, j ) = ( b( 2, j )-du( 1 )*b( 1, j ) ) / d( 2 )
259 DO 100 i = 3, n
260 b( i, j ) = ( b( i, j )-du( i-1 )*b( i-1, j )-
261 $ du2( i-2 )*b( i-2, j ) ) / d( i )
262 100 CONTINUE
263*
264* Solve L**T * x = b.
265*
266 DO 110 i = n - 1, 1, -1
267 IF( ipiv( i ).EQ.i ) THEN
268 b( i, j ) = b( i, j ) - dl( i )*b( i+1, j )
269 ELSE
270 temp = b( i+1, j )
271 b( i+1, j ) = b( i, j ) - dl( i )*temp
272 b( i, j ) = temp
273 END IF
274 110 CONTINUE
275 120 CONTINUE
276 END IF
277 ELSE
278*
279* Solve A**H * X = B.
280*
281 IF( nrhs.LE.1 ) THEN
282 j = 1
283 130 CONTINUE
284*
285* Solve U**H * x = b.
286*
287 b( 1, j ) = b( 1, j ) / conjg( d( 1 ) )
288 IF( n.GT.1 )
289 $ b( 2, j ) = ( b( 2, j )-conjg( du( 1 ) )*b( 1, j ) ) /
290 $ conjg( d( 2 ) )
291 DO 140 i = 3, n
292 b( i, j ) = ( b( i, j )-conjg( du( i-1 ) )*b( i-1, j )-
293 $ conjg( du2( i-2 ) )*b( i-2, j ) ) /
294 $ conjg( d( i ) )
295 140 CONTINUE
296*
297* Solve L**H * x = b.
298*
299 DO 150 i = n - 1, 1, -1
300 IF( ipiv( i ).EQ.i ) THEN
301 b( i, j ) = b( i, j ) - conjg( dl( i ) )*b( i+1, j )
302 ELSE
303 temp = b( i+1, j )
304 b( i+1, j ) = b( i, j ) - conjg( dl( i ) )*temp
305 b( i, j ) = temp
306 END IF
307 150 CONTINUE
308 IF( j.LT.nrhs ) THEN
309 j = j + 1
310 GO TO 130
311 END IF
312 ELSE
313 DO 180 j = 1, nrhs
314*
315* Solve U**H * x = b.
316*
317 b( 1, j ) = b( 1, j ) / conjg( d( 1 ) )
318 IF( n.GT.1 )
319 $ b( 2, j ) = ( b( 2, j )-conjg( du( 1 ) )*b( 1, j ) ) /
320 $ conjg( d( 2 ) )
321 DO 160 i = 3, n
322 b( i, j ) = ( b( i, j )-conjg( du( i-1 ) )*
323 $ b( i-1, j )-conjg( du2( i-2 ) )*
324 $ b( i-2, j ) ) / conjg( d( i ) )
325 160 CONTINUE
326*
327* Solve L**H * x = b.
328*
329 DO 170 i = n - 1, 1, -1
330 IF( ipiv( i ).EQ.i ) THEN
331 b( i, j ) = b( i, j ) - conjg( dl( i ) )*
332 $ b( i+1, j )
333 ELSE
334 temp = b( i+1, j )
335 b( i+1, j ) = b( i, j ) - conjg( dl( i ) )*temp
336 b( i, j ) = temp
337 END IF
338 170 CONTINUE
339 180 CONTINUE
340 END IF
341 END IF
342*
343* End of CGTTS2
344*
345 END
cgtts2
subroutine cgtts2(itrans, n, nrhs, dl, d, du, du2, ipiv, b, ldb)
CGTTS2 solves a system of linear equations with a tridiagonal matrix using the LU factorization compu...
Definition cgtts2.f:127