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