Annotation of rpl/lapack/lapack/zlagtm.f, revision 1.19
1.12 bertrand 1: *> \brief \b ZLAGTM performs a matrix-matrix product of the form C = αAB+βC, where A is a tridiagonal matrix, B and C are rectangular matrices, and α and β are scalars, which may be 0, 1, or -1.
1.9 bertrand 2: *
3: * =========== DOCUMENTATION ===========
4: *
1.16 bertrand 5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
1.9 bertrand 7: *
8: *> \htmlonly
1.16 bertrand 9: *> Download ZLAGTM + dependencies
10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlagtm.f">
11: *> [TGZ]</a>
12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlagtm.f">
13: *> [ZIP]</a>
14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlagtm.f">
1.9 bertrand 15: *> [TXT]</a>
1.16 bertrand 16: *> \endhtmlonly
1.9 bertrand 17: *
18: * Definition:
19: * ===========
20: *
21: * SUBROUTINE ZLAGTM( TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA,
22: * B, LDB )
1.16 bertrand 23: *
1.9 bertrand 24: * .. Scalar Arguments ..
25: * CHARACTER TRANS
26: * INTEGER LDB, LDX, N, NRHS
27: * DOUBLE PRECISION ALPHA, BETA
28: * ..
29: * .. Array Arguments ..
30: * COMPLEX*16 B( LDB, * ), D( * ), DL( * ), DU( * ),
31: * $ X( LDX, * )
32: * ..
1.16 bertrand 33: *
1.9 bertrand 34: *
35: *> \par Purpose:
36: * =============
37: *>
38: *> \verbatim
39: *>
40: *> ZLAGTM performs a matrix-vector product of the form
41: *>
42: *> B := alpha * A * X + beta * B
43: *>
44: *> where A is a tridiagonal matrix of order N, B and X are N by NRHS
45: *> matrices, and alpha and beta are real scalars, each of which may be
46: *> 0., 1., or -1.
47: *> \endverbatim
48: *
49: * Arguments:
50: * ==========
51: *
52: *> \param[in] TRANS
53: *> \verbatim
54: *> TRANS is CHARACTER*1
55: *> Specifies the operation applied to A.
56: *> = 'N': No transpose, B := alpha * A * X + beta * B
57: *> = 'T': Transpose, B := alpha * A**T * X + beta * B
58: *> = 'C': Conjugate transpose, B := alpha * A**H * X + beta * B
59: *> \endverbatim
60: *>
61: *> \param[in] N
62: *> \verbatim
63: *> N is INTEGER
64: *> The order of the matrix A. N >= 0.
65: *> \endverbatim
66: *>
67: *> \param[in] NRHS
68: *> \verbatim
69: *> NRHS is INTEGER
70: *> The number of right hand sides, i.e., the number of columns
71: *> of the matrices X and B.
72: *> \endverbatim
73: *>
74: *> \param[in] ALPHA
75: *> \verbatim
76: *> ALPHA is DOUBLE PRECISION
77: *> The scalar alpha. ALPHA must be 0., 1., or -1.; otherwise,
78: *> it is assumed to be 0.
79: *> \endverbatim
80: *>
81: *> \param[in] DL
82: *> \verbatim
83: *> DL is COMPLEX*16 array, dimension (N-1)
84: *> The (n-1) sub-diagonal elements of T.
85: *> \endverbatim
86: *>
87: *> \param[in] D
88: *> \verbatim
89: *> D is COMPLEX*16 array, dimension (N)
90: *> The diagonal elements of T.
91: *> \endverbatim
92: *>
93: *> \param[in] DU
94: *> \verbatim
95: *> DU is COMPLEX*16 array, dimension (N-1)
96: *> The (n-1) super-diagonal elements of T.
97: *> \endverbatim
98: *>
99: *> \param[in] X
100: *> \verbatim
101: *> X is COMPLEX*16 array, dimension (LDX,NRHS)
102: *> The N by NRHS matrix X.
103: *> \endverbatim
104: *>
105: *> \param[in] LDX
106: *> \verbatim
107: *> LDX is INTEGER
108: *> The leading dimension of the array X. LDX >= max(N,1).
109: *> \endverbatim
110: *>
111: *> \param[in] BETA
112: *> \verbatim
113: *> BETA is DOUBLE PRECISION
114: *> The scalar beta. BETA must be 0., 1., or -1.; otherwise,
115: *> it is assumed to be 1.
116: *> \endverbatim
117: *>
118: *> \param[in,out] B
119: *> \verbatim
120: *> B is COMPLEX*16 array, dimension (LDB,NRHS)
121: *> On entry, the N by NRHS matrix B.
122: *> On exit, B is overwritten by the matrix expression
123: *> B := alpha * A * X + beta * B.
124: *> \endverbatim
125: *>
126: *> \param[in] LDB
127: *> \verbatim
128: *> LDB is INTEGER
129: *> The leading dimension of the array B. LDB >= max(N,1).
130: *> \endverbatim
131: *
132: * Authors:
133: * ========
134: *
1.16 bertrand 135: *> \author Univ. of Tennessee
136: *> \author Univ. of California Berkeley
137: *> \author Univ. of Colorado Denver
138: *> \author NAG Ltd.
1.9 bertrand 139: *
140: *> \ingroup complex16OTHERauxiliary
141: *
142: * =====================================================================
1.1 bertrand 143: SUBROUTINE ZLAGTM( TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA,
144: $ B, LDB )
145: *
1.19 ! bertrand 146: * -- LAPACK auxiliary routine --
1.1 bertrand 147: * -- LAPACK is a software package provided by Univ. of Tennessee, --
148: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
149: *
150: * .. Scalar Arguments ..
151: CHARACTER TRANS
152: INTEGER LDB, LDX, N, NRHS
153: DOUBLE PRECISION ALPHA, BETA
154: * ..
155: * .. Array Arguments ..
156: COMPLEX*16 B( LDB, * ), D( * ), DL( * ), DU( * ),
157: $ X( LDX, * )
158: * ..
159: *
160: * =====================================================================
161: *
162: * .. Parameters ..
163: DOUBLE PRECISION ONE, ZERO
164: PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
165: * ..
166: * .. Local Scalars ..
167: INTEGER I, J
168: * ..
169: * .. External Functions ..
170: LOGICAL LSAME
171: EXTERNAL LSAME
172: * ..
173: * .. Intrinsic Functions ..
174: INTRINSIC DCONJG
175: * ..
176: * .. Executable Statements ..
177: *
178: IF( N.EQ.0 )
179: $ RETURN
180: *
181: * Multiply B by BETA if BETA.NE.1.
182: *
183: IF( BETA.EQ.ZERO ) THEN
184: DO 20 J = 1, NRHS
185: DO 10 I = 1, N
186: B( I, J ) = ZERO
187: 10 CONTINUE
188: 20 CONTINUE
189: ELSE IF( BETA.EQ.-ONE ) THEN
190: DO 40 J = 1, NRHS
191: DO 30 I = 1, N
192: B( I, J ) = -B( I, J )
193: 30 CONTINUE
194: 40 CONTINUE
195: END IF
196: *
197: IF( ALPHA.EQ.ONE ) THEN
198: IF( LSAME( TRANS, 'N' ) ) THEN
199: *
200: * Compute B := B + A*X
201: *
202: DO 60 J = 1, NRHS
203: IF( N.EQ.1 ) THEN
204: B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J )
205: ELSE
206: B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) +
207: $ DU( 1 )*X( 2, J )
208: B( N, J ) = B( N, J ) + DL( N-1 )*X( N-1, J ) +
209: $ D( N )*X( N, J )
210: DO 50 I = 2, N - 1
211: B( I, J ) = B( I, J ) + DL( I-1 )*X( I-1, J ) +
212: $ D( I )*X( I, J ) + DU( I )*X( I+1, J )
213: 50 CONTINUE
214: END IF
215: 60 CONTINUE
216: ELSE IF( LSAME( TRANS, 'T' ) ) THEN
217: *
218: * Compute B := B + A**T * X
219: *
220: DO 80 J = 1, NRHS
221: IF( N.EQ.1 ) THEN
222: B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J )
223: ELSE
224: B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) +
225: $ DL( 1 )*X( 2, J )
226: B( N, J ) = B( N, J ) + DU( N-1 )*X( N-1, J ) +
227: $ D( N )*X( N, J )
228: DO 70 I = 2, N - 1
229: B( I, J ) = B( I, J ) + DU( I-1 )*X( I-1, J ) +
230: $ D( I )*X( I, J ) + DL( I )*X( I+1, J )
231: 70 CONTINUE
232: END IF
233: 80 CONTINUE
234: ELSE IF( LSAME( TRANS, 'C' ) ) THEN
235: *
236: * Compute B := B + A**H * X
237: *
238: DO 100 J = 1, NRHS
239: IF( N.EQ.1 ) THEN
240: B( 1, J ) = B( 1, J ) + DCONJG( D( 1 ) )*X( 1, J )
241: ELSE
242: B( 1, J ) = B( 1, J ) + DCONJG( D( 1 ) )*X( 1, J ) +
243: $ DCONJG( DL( 1 ) )*X( 2, J )
244: B( N, J ) = B( N, J ) + DCONJG( DU( N-1 ) )*
245: $ X( N-1, J ) + DCONJG( D( N ) )*X( N, J )
246: DO 90 I = 2, N - 1
247: B( I, J ) = B( I, J ) + DCONJG( DU( I-1 ) )*
248: $ X( I-1, J ) + DCONJG( D( I ) )*
249: $ X( I, J ) + DCONJG( DL( I ) )*
250: $ X( I+1, J )
251: 90 CONTINUE
252: END IF
253: 100 CONTINUE
254: END IF
255: ELSE IF( ALPHA.EQ.-ONE ) THEN
256: IF( LSAME( TRANS, 'N' ) ) THEN
257: *
258: * Compute B := B - A*X
259: *
260: DO 120 J = 1, NRHS
261: IF( N.EQ.1 ) THEN
262: B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J )
263: ELSE
264: B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) -
265: $ DU( 1 )*X( 2, J )
266: B( N, J ) = B( N, J ) - DL( N-1 )*X( N-1, J ) -
267: $ D( N )*X( N, J )
268: DO 110 I = 2, N - 1
269: B( I, J ) = B( I, J ) - DL( I-1 )*X( I-1, J ) -
270: $ D( I )*X( I, J ) - DU( I )*X( I+1, J )
271: 110 CONTINUE
272: END IF
273: 120 CONTINUE
274: ELSE IF( LSAME( TRANS, 'T' ) ) THEN
275: *
1.8 bertrand 276: * Compute B := B - A**T *X
1.1 bertrand 277: *
278: DO 140 J = 1, NRHS
279: IF( N.EQ.1 ) THEN
280: B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J )
281: ELSE
282: B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) -
283: $ DL( 1 )*X( 2, J )
284: B( N, J ) = B( N, J ) - DU( N-1 )*X( N-1, J ) -
285: $ D( N )*X( N, J )
286: DO 130 I = 2, N - 1
287: B( I, J ) = B( I, J ) - DU( I-1 )*X( I-1, J ) -
288: $ D( I )*X( I, J ) - DL( I )*X( I+1, J )
289: 130 CONTINUE
290: END IF
291: 140 CONTINUE
292: ELSE IF( LSAME( TRANS, 'C' ) ) THEN
293: *
1.8 bertrand 294: * Compute B := B - A**H *X
1.1 bertrand 295: *
296: DO 160 J = 1, NRHS
297: IF( N.EQ.1 ) THEN
298: B( 1, J ) = B( 1, J ) - DCONJG( D( 1 ) )*X( 1, J )
299: ELSE
300: B( 1, J ) = B( 1, J ) - DCONJG( D( 1 ) )*X( 1, J ) -
301: $ DCONJG( DL( 1 ) )*X( 2, J )
302: B( N, J ) = B( N, J ) - DCONJG( DU( N-1 ) )*
303: $ X( N-1, J ) - DCONJG( D( N ) )*X( N, J )
304: DO 150 I = 2, N - 1
305: B( I, J ) = B( I, J ) - DCONJG( DU( I-1 ) )*
306: $ X( I-1, J ) - DCONJG( D( I ) )*
307: $ X( I, J ) - DCONJG( DL( I ) )*
308: $ X( I+1, J )
309: 150 CONTINUE
310: END IF
311: 160 CONTINUE
312: END IF
313: END IF
314: RETURN
315: *
316: * End of ZLAGTM
317: *
318: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zlagtm.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack