1: *> \brief \b ZGTTS2 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 ZGTTS2 + dependencies
10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgtts2.f">
11: *> [TGZ]</a>
12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgtts2.f">
13: *> [ZIP]</a>
14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgtts2.f">
15: *> [TXT]</a>
16: *> \endhtmlonly
17: *
18: * Definition:
19: * ===========
20: *
21: * SUBROUTINE ZGTTS2( 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*16 B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * )
29: * ..
30: *
31: *
32: *> \par Purpose:
33: * =============
34: *>
35: *> \verbatim
36: *>
37: *> ZGTTS2 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 ZGTTRF.
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*16 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*16 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*16 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*16 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*16 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: *> \ingroup complex16GTcomputational
125: *
126: * =====================================================================
127: SUBROUTINE ZGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB )
128: *
129: * -- LAPACK computational routine --
130: * -- LAPACK is a software package provided by Univ. of Tennessee, --
131: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
132: *
133: * .. Scalar Arguments ..
134: INTEGER ITRANS, LDB, N, NRHS
135: * ..
136: * .. Array Arguments ..
137: INTEGER IPIV( * )
138: COMPLEX*16 B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * )
139: * ..
140: *
141: * =====================================================================
142: *
143: * .. Local Scalars ..
144: INTEGER I, J
145: COMPLEX*16 TEMP
146: * ..
147: * .. Intrinsic Functions ..
148: INTRINSIC DCONJG
149: * ..
150: * .. Executable Statements ..
151: *
152: * Quick return if possible
153: *
154: IF( N.EQ.0 .OR. NRHS.EQ.0 )
155: $ RETURN
156: *
157: IF( ITRANS.EQ.0 ) THEN
158: *
159: * Solve A*X = B using the LU factorization of A,
160: * overwriting each right hand side vector with its solution.
161: *
162: IF( NRHS.LE.1 ) THEN
163: J = 1
164: 10 CONTINUE
165: *
166: * Solve L*x = b.
167: *
168: DO 20 I = 1, N - 1
169: IF( IPIV( I ).EQ.I ) THEN
170: B( I+1, J ) = B( I+1, J ) - DL( I )*B( I, J )
171: ELSE
172: TEMP = B( I, J )
173: B( I, J ) = B( I+1, J )
174: B( I+1, J ) = TEMP - DL( I )*B( I, J )
175: END IF
176: 20 CONTINUE
177: *
178: * Solve U*x = b.
179: *
180: B( N, J ) = B( N, J ) / D( N )
181: IF( N.GT.1 )
182: $ B( N-1, J ) = ( B( N-1, J )-DU( N-1 )*B( N, J ) ) /
183: $ D( N-1 )
184: DO 30 I = N - 2, 1, -1
185: B( I, J ) = ( B( I, J )-DU( I )*B( I+1, J )-DU2( I )*
186: $ B( I+2, J ) ) / D( I )
187: 30 CONTINUE
188: IF( J.LT.NRHS ) THEN
189: J = J + 1
190: GO TO 10
191: END IF
192: ELSE
193: DO 60 J = 1, NRHS
194: *
195: * Solve L*x = b.
196: *
197: DO 40 I = 1, N - 1
198: IF( IPIV( I ).EQ.I ) THEN
199: B( I+1, J ) = B( I+1, J ) - DL( I )*B( I, J )
200: ELSE
201: TEMP = B( I, J )
202: B( I, J ) = B( I+1, J )
203: B( I+1, J ) = TEMP - DL( I )*B( I, J )
204: END IF
205: 40 CONTINUE
206: *
207: * Solve U*x = b.
208: *
209: B( N, J ) = B( N, J ) / D( N )
210: IF( N.GT.1 )
211: $ B( N-1, J ) = ( B( N-1, J )-DU( N-1 )*B( N, J ) ) /
212: $ D( N-1 )
213: DO 50 I = N - 2, 1, -1
214: B( I, J ) = ( B( I, J )-DU( I )*B( I+1, J )-DU2( I )*
215: $ B( I+2, J ) ) / D( I )
216: 50 CONTINUE
217: 60 CONTINUE
218: END IF
219: ELSE IF( ITRANS.EQ.1 ) THEN
220: *
221: * Solve A**T * X = B.
222: *
223: IF( NRHS.LE.1 ) THEN
224: J = 1
225: 70 CONTINUE
226: *
227: * Solve U**T * x = b.
228: *
229: B( 1, J ) = B( 1, J ) / D( 1 )
230: IF( N.GT.1 )
231: $ B( 2, J ) = ( B( 2, J )-DU( 1 )*B( 1, J ) ) / D( 2 )
232: DO 80 I = 3, N
233: B( I, J ) = ( B( I, J )-DU( I-1 )*B( I-1, J )-DU2( I-2 )*
234: $ B( I-2, J ) ) / D( I )
235: 80 CONTINUE
236: *
237: * Solve L**T * x = b.
238: *
239: DO 90 I = N - 1, 1, -1
240: IF( IPIV( I ).EQ.I ) THEN
241: B( I, J ) = B( I, J ) - DL( I )*B( I+1, J )
242: ELSE
243: TEMP = B( I+1, J )
244: B( I+1, J ) = B( I, J ) - DL( I )*TEMP
245: B( I, J ) = TEMP
246: END IF
247: 90 CONTINUE
248: IF( J.LT.NRHS ) THEN
249: J = J + 1
250: GO TO 70
251: END IF
252: ELSE
253: DO 120 J = 1, NRHS
254: *
255: * Solve U**T * x = b.
256: *
257: B( 1, J ) = B( 1, J ) / D( 1 )
258: IF( N.GT.1 )
259: $ B( 2, J ) = ( B( 2, J )-DU( 1 )*B( 1, J ) ) / D( 2 )
260: DO 100 I = 3, N
261: B( I, J ) = ( B( I, J )-DU( I-1 )*B( I-1, J )-
262: $ DU2( I-2 )*B( I-2, J ) ) / D( I )
263: 100 CONTINUE
264: *
265: * Solve L**T * x = b.
266: *
267: DO 110 I = N - 1, 1, -1
268: IF( IPIV( I ).EQ.I ) THEN
269: B( I, J ) = B( I, J ) - DL( I )*B( I+1, J )
270: ELSE
271: TEMP = B( I+1, J )
272: B( I+1, J ) = B( I, J ) - DL( I )*TEMP
273: B( I, J ) = TEMP
274: END IF
275: 110 CONTINUE
276: 120 CONTINUE
277: END IF
278: ELSE
279: *
280: * Solve A**H * X = B.
281: *
282: IF( NRHS.LE.1 ) THEN
283: J = 1
284: 130 CONTINUE
285: *
286: * Solve U**H * x = b.
287: *
288: B( 1, J ) = B( 1, J ) / DCONJG( D( 1 ) )
289: IF( N.GT.1 )
290: $ B( 2, J ) = ( B( 2, J )-DCONJG( DU( 1 ) )*B( 1, J ) ) /
291: $ DCONJG( D( 2 ) )
292: DO 140 I = 3, N
293: B( I, J ) = ( B( I, J )-DCONJG( DU( I-1 ) )*B( I-1, J )-
294: $ DCONJG( DU2( I-2 ) )*B( I-2, J ) ) /
295: $ DCONJG( D( I ) )
296: 140 CONTINUE
297: *
298: * Solve L**H * x = b.
299: *
300: DO 150 I = N - 1, 1, -1
301: IF( IPIV( I ).EQ.I ) THEN
302: B( I, J ) = B( I, J ) - DCONJG( DL( I ) )*B( I+1, J )
303: ELSE
304: TEMP = B( I+1, J )
305: B( I+1, J ) = B( I, J ) - DCONJG( DL( I ) )*TEMP
306: B( I, J ) = TEMP
307: END IF
308: 150 CONTINUE
309: IF( J.LT.NRHS ) THEN
310: J = J + 1
311: GO TO 130
312: END IF
313: ELSE
314: DO 180 J = 1, NRHS
315: *
316: * Solve U**H * x = b.
317: *
318: B( 1, J ) = B( 1, J ) / DCONJG( D( 1 ) )
319: IF( N.GT.1 )
320: $ B( 2, J ) = ( B( 2, J )-DCONJG( DU( 1 ) )*B( 1, J ) )
321: $ / DCONJG( D( 2 ) )
322: DO 160 I = 3, N
323: B( I, J ) = ( B( I, J )-DCONJG( DU( I-1 ) )*
324: $ B( I-1, J )-DCONJG( DU2( I-2 ) )*
325: $ B( I-2, J ) ) / DCONJG( D( I ) )
326: 160 CONTINUE
327: *
328: * Solve L**H * x = b.
329: *
330: DO 170 I = N - 1, 1, -1
331: IF( IPIV( I ).EQ.I ) THEN
332: B( I, J ) = B( I, J ) - DCONJG( DL( I ) )*
333: $ B( I+1, J )
334: ELSE
335: TEMP = B( I+1, J )
336: B( I+1, J ) = B( I, J ) - DCONJG( DL( I ) )*TEMP
337: B( I, J ) = TEMP
338: END IF
339: 170 CONTINUE
340: 180 CONTINUE
341: END IF
342: END IF
343: *
344: * End of ZGTTS2
345: *
346: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zgtts2.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack