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