Annotation of rpl/lapack/lapack/zlagtm.f, revision 1.9
1.9 ! bertrand 1: *> \brief \b ZLAGTM
! 2: *
! 3: * =========== DOCUMENTATION ===========
! 4: *
! 5: * Online html documentation available at
! 6: * http://www.netlib.org/lapack/explore-html/
! 7: *
! 8: *> \htmlonly
! 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">
! 15: *> [TXT]</a>
! 16: *> \endhtmlonly
! 17: *
! 18: * Definition:
! 19: * ===========
! 20: *
! 21: * SUBROUTINE ZLAGTM( TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA,
! 22: * B, LDB )
! 23: *
! 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: * ..
! 33: *
! 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: *
! 135: *> \author Univ. of Tennessee
! 136: *> \author Univ. of California Berkeley
! 137: *> \author Univ. of Colorado Denver
! 138: *> \author NAG Ltd.
! 139: *
! 140: *> \date November 2011
! 141: *
! 142: *> \ingroup complex16OTHERauxiliary
! 143: *
! 144: * =====================================================================
1.1 bertrand 145: SUBROUTINE ZLAGTM( TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA,
146: $ B, LDB )
147: *
1.9 ! bertrand 148: * -- LAPACK auxiliary routine (version 3.4.0) --
1.1 bertrand 149: * -- LAPACK is a software package provided by Univ. of Tennessee, --
150: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.9 ! bertrand 151: * November 2011
1.1 bertrand 152: *
153: * .. Scalar Arguments ..
154: CHARACTER TRANS
155: INTEGER LDB, LDX, N, NRHS
156: DOUBLE PRECISION ALPHA, BETA
157: * ..
158: * .. Array Arguments ..
159: COMPLEX*16 B( LDB, * ), D( * ), DL( * ), DU( * ),
160: $ X( LDX, * )
161: * ..
162: *
163: * =====================================================================
164: *
165: * .. Parameters ..
166: DOUBLE PRECISION ONE, ZERO
167: PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
168: * ..
169: * .. Local Scalars ..
170: INTEGER I, J
171: * ..
172: * .. External Functions ..
173: LOGICAL LSAME
174: EXTERNAL LSAME
175: * ..
176: * .. Intrinsic Functions ..
177: INTRINSIC DCONJG
178: * ..
179: * .. Executable Statements ..
180: *
181: IF( N.EQ.0 )
182: $ RETURN
183: *
184: * Multiply B by BETA if BETA.NE.1.
185: *
186: IF( BETA.EQ.ZERO ) THEN
187: DO 20 J = 1, NRHS
188: DO 10 I = 1, N
189: B( I, J ) = ZERO
190: 10 CONTINUE
191: 20 CONTINUE
192: ELSE IF( BETA.EQ.-ONE ) THEN
193: DO 40 J = 1, NRHS
194: DO 30 I = 1, N
195: B( I, J ) = -B( I, J )
196: 30 CONTINUE
197: 40 CONTINUE
198: END IF
199: *
200: IF( ALPHA.EQ.ONE ) THEN
201: IF( LSAME( TRANS, 'N' ) ) THEN
202: *
203: * Compute B := B + A*X
204: *
205: DO 60 J = 1, NRHS
206: IF( N.EQ.1 ) THEN
207: B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J )
208: ELSE
209: B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) +
210: $ DU( 1 )*X( 2, J )
211: B( N, J ) = B( N, J ) + DL( N-1 )*X( N-1, J ) +
212: $ D( N )*X( N, J )
213: DO 50 I = 2, N - 1
214: B( I, J ) = B( I, J ) + DL( I-1 )*X( I-1, J ) +
215: $ D( I )*X( I, J ) + DU( I )*X( I+1, J )
216: 50 CONTINUE
217: END IF
218: 60 CONTINUE
219: ELSE IF( LSAME( TRANS, 'T' ) ) THEN
220: *
221: * Compute B := B + A**T * X
222: *
223: DO 80 J = 1, NRHS
224: IF( N.EQ.1 ) THEN
225: B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J )
226: ELSE
227: B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) +
228: $ DL( 1 )*X( 2, J )
229: B( N, J ) = B( N, J ) + DU( N-1 )*X( N-1, J ) +
230: $ D( N )*X( N, J )
231: DO 70 I = 2, N - 1
232: B( I, J ) = B( I, J ) + DU( I-1 )*X( I-1, J ) +
233: $ D( I )*X( I, J ) + DL( I )*X( I+1, J )
234: 70 CONTINUE
235: END IF
236: 80 CONTINUE
237: ELSE IF( LSAME( TRANS, 'C' ) ) THEN
238: *
239: * Compute B := B + A**H * X
240: *
241: DO 100 J = 1, NRHS
242: IF( N.EQ.1 ) THEN
243: B( 1, J ) = B( 1, J ) + DCONJG( D( 1 ) )*X( 1, J )
244: ELSE
245: B( 1, J ) = B( 1, J ) + DCONJG( D( 1 ) )*X( 1, J ) +
246: $ DCONJG( DL( 1 ) )*X( 2, J )
247: B( N, J ) = B( N, J ) + DCONJG( DU( N-1 ) )*
248: $ X( N-1, J ) + DCONJG( D( N ) )*X( N, J )
249: DO 90 I = 2, N - 1
250: B( I, J ) = B( I, J ) + DCONJG( DU( I-1 ) )*
251: $ X( I-1, J ) + DCONJG( D( I ) )*
252: $ X( I, J ) + DCONJG( DL( I ) )*
253: $ X( I+1, J )
254: 90 CONTINUE
255: END IF
256: 100 CONTINUE
257: END IF
258: ELSE IF( ALPHA.EQ.-ONE ) THEN
259: IF( LSAME( TRANS, 'N' ) ) THEN
260: *
261: * Compute B := B - A*X
262: *
263: DO 120 J = 1, NRHS
264: IF( N.EQ.1 ) THEN
265: B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J )
266: ELSE
267: B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) -
268: $ DU( 1 )*X( 2, J )
269: B( N, J ) = B( N, J ) - DL( N-1 )*X( N-1, J ) -
270: $ D( N )*X( N, J )
271: DO 110 I = 2, N - 1
272: B( I, J ) = B( I, J ) - DL( I-1 )*X( I-1, J ) -
273: $ D( I )*X( I, J ) - DU( I )*X( I+1, J )
274: 110 CONTINUE
275: END IF
276: 120 CONTINUE
277: ELSE IF( LSAME( TRANS, 'T' ) ) THEN
278: *
1.8 bertrand 279: * Compute B := B - A**T *X
1.1 bertrand 280: *
281: DO 140 J = 1, NRHS
282: IF( N.EQ.1 ) THEN
283: B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J )
284: ELSE
285: B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) -
286: $ DL( 1 )*X( 2, J )
287: B( N, J ) = B( N, J ) - DU( N-1 )*X( N-1, J ) -
288: $ D( N )*X( N, J )
289: DO 130 I = 2, N - 1
290: B( I, J ) = B( I, J ) - DU( I-1 )*X( I-1, J ) -
291: $ D( I )*X( I, J ) - DL( I )*X( I+1, J )
292: 130 CONTINUE
293: END IF
294: 140 CONTINUE
295: ELSE IF( LSAME( TRANS, 'C' ) ) THEN
296: *
1.8 bertrand 297: * Compute B := B - A**H *X
1.1 bertrand 298: *
299: DO 160 J = 1, NRHS
300: IF( N.EQ.1 ) THEN
301: B( 1, J ) = B( 1, J ) - DCONJG( D( 1 ) )*X( 1, J )
302: ELSE
303: B( 1, J ) = B( 1, J ) - DCONJG( D( 1 ) )*X( 1, J ) -
304: $ DCONJG( DL( 1 ) )*X( 2, J )
305: B( N, J ) = B( N, J ) - DCONJG( DU( N-1 ) )*
306: $ X( N-1, J ) - DCONJG( D( N ) )*X( N, J )
307: DO 150 I = 2, N - 1
308: B( I, J ) = B( I, J ) - DCONJG( DU( I-1 ) )*
309: $ X( I-1, J ) - DCONJG( D( I ) )*
310: $ X( I, J ) - DCONJG( DL( I ) )*
311: $ X( I+1, J )
312: 150 CONTINUE
313: END IF
314: 160 CONTINUE
315: END IF
316: END IF
317: RETURN
318: *
319: * End of ZLAGTM
320: *
321: 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