LAPACK 3.12.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches
dlagtm.f
Go to the documentation of this file.
1*> \brief \b DLAGTM 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*> \htmlonly
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlagtm.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlagtm.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlagtm.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE DLAGTM( 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* DOUBLE PRECISION B( LDB, * ), D( * ), DL( * ), DU( * ),
31* \$ X( LDX, * )
32* ..
33*
34*
35*> \par Purpose:
36* =============
37*>
38*> \verbatim
39*>
40*> DLAGTM performs a matrix-matrix 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'* X + beta * B
58*> = 'C': Conjugate transpose = Transpose
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 DOUBLE PRECISION 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 DOUBLE PRECISION array, dimension (N)
90*> The diagonal elements of T.
91*> \endverbatim
92*>
93*> \param[in] DU
94*> \verbatim
95*> DU is DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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*> \ingroup lagtm
141*
142* =====================================================================
143 SUBROUTINE dlagtm( TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA,
144 \$ B, LDB )
145*
146* -- LAPACK auxiliary routine --
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 DOUBLE PRECISION 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* .. Executable Statements ..
174*
175 IF( n.EQ.0 )
176 \$ RETURN
177*
178* Multiply B by BETA if BETA.NE.1.
179*
180 IF( beta.EQ.zero ) THEN
181 DO 20 j = 1, nrhs
182 DO 10 i = 1, n
183 b( i, j ) = zero
184 10 CONTINUE
185 20 CONTINUE
186 ELSE IF( beta.EQ.-one ) THEN
187 DO 40 j = 1, nrhs
188 DO 30 i = 1, n
189 b( i, j ) = -b( i, j )
190 30 CONTINUE
191 40 CONTINUE
192 END IF
193*
194 IF( alpha.EQ.one ) THEN
195 IF( lsame( trans, 'N' ) ) THEN
196*
197* Compute B := B + A*X
198*
199 DO 60 j = 1, nrhs
200 IF( n.EQ.1 ) THEN
201 b( 1, j ) = b( 1, j ) + d( 1 )*x( 1, j )
202 ELSE
203 b( 1, j ) = b( 1, j ) + d( 1 )*x( 1, j ) +
204 \$ du( 1 )*x( 2, j )
205 b( n, j ) = b( n, j ) + dl( n-1 )*x( n-1, j ) +
206 \$ d( n )*x( n, j )
207 DO 50 i = 2, n - 1
208 b( i, j ) = b( i, j ) + dl( i-1 )*x( i-1, j ) +
209 \$ d( i )*x( i, j ) + du( i )*x( i+1, j )
210 50 CONTINUE
211 END IF
212 60 CONTINUE
213 ELSE
214*
215* Compute B := B + A**T*X
216*
217 DO 80 j = 1, nrhs
218 IF( n.EQ.1 ) THEN
219 b( 1, j ) = b( 1, j ) + d( 1 )*x( 1, j )
220 ELSE
221 b( 1, j ) = b( 1, j ) + d( 1 )*x( 1, j ) +
222 \$ dl( 1 )*x( 2, j )
223 b( n, j ) = b( n, j ) + du( n-1 )*x( n-1, j ) +
224 \$ d( n )*x( n, j )
225 DO 70 i = 2, n - 1
226 b( i, j ) = b( i, j ) + du( i-1 )*x( i-1, j ) +
227 \$ d( i )*x( i, j ) + dl( i )*x( i+1, j )
228 70 CONTINUE
229 END IF
230 80 CONTINUE
231 END IF
232 ELSE IF( alpha.EQ.-one ) THEN
233 IF( lsame( trans, 'N' ) ) THEN
234*
235* Compute B := B - A*X
236*
237 DO 100 j = 1, nrhs
238 IF( n.EQ.1 ) THEN
239 b( 1, j ) = b( 1, j ) - d( 1 )*x( 1, j )
240 ELSE
241 b( 1, j ) = b( 1, j ) - d( 1 )*x( 1, j ) -
242 \$ du( 1 )*x( 2, j )
243 b( n, j ) = b( n, j ) - dl( n-1 )*x( n-1, j ) -
244 \$ d( n )*x( n, j )
245 DO 90 i = 2, n - 1
246 b( i, j ) = b( i, j ) - dl( i-1 )*x( i-1, j ) -
247 \$ d( i )*x( i, j ) - du( i )*x( i+1, j )
248 90 CONTINUE
249 END IF
250 100 CONTINUE
251 ELSE
252*
253* Compute B := B - A**T*X
254*
255 DO 120 j = 1, nrhs
256 IF( n.EQ.1 ) THEN
257 b( 1, j ) = b( 1, j ) - d( 1 )*x( 1, j )
258 ELSE
259 b( 1, j ) = b( 1, j ) - d( 1 )*x( 1, j ) -
260 \$ dl( 1 )*x( 2, j )
261 b( n, j ) = b( n, j ) - du( n-1 )*x( n-1, j ) -
262 \$ d( n )*x( n, j )
263 DO 110 i = 2, n - 1
264 b( i, j ) = b( i, j ) - du( i-1 )*x( i-1, j ) -
265 \$ d( i )*x( i, j ) - dl( i )*x( i+1, j )
266 110 CONTINUE
267 END IF
268 120 CONTINUE
269 END IF
270 END IF
271 RETURN
272*
273* End of DLAGTM
274*
275 END
subroutine dlagtm(trans, n, nrhs, alpha, dl, d, du, x, ldx, beta, b, ldb)
DLAGTM performs a matrix-matrix product of the form C = αAB+βC, where A is a tridiagonal matrix,...
Definition dlagtm.f:145