LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
dlatrd.f
Go to the documentation of this file.
1*> \brief \b DLATRD reduces the first nb rows and columns of a symmetric/Hermitian matrix A to real tridiagonal form by an orthogonal similarity transformation.
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download DLATRD + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlatrd.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlatrd.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlatrd.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE DLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW )
22*
23* .. Scalar Arguments ..
24* CHARACTER UPLO
25* INTEGER LDA, LDW, N, NB
26* ..
27* .. Array Arguments ..
28* DOUBLE PRECISION A( LDA, * ), E( * ), TAU( * ), W( LDW, * )
29* ..
30*
31*
32*> \par Purpose:
33* =============
34*>
35*> \verbatim
36*>
37*> DLATRD reduces NB rows and columns of a real symmetric matrix A to
38*> symmetric tridiagonal form by an orthogonal similarity
39*> transformation Q**T * A * Q, and returns the matrices V and W which are
40*> needed to apply the transformation to the unreduced part of A.
41*>
42*> If UPLO = 'U', DLATRD reduces the last NB rows and columns of a
43*> matrix, of which the upper triangle is supplied;
44*> if UPLO = 'L', DLATRD reduces the first NB rows and columns of a
45*> matrix, of which the lower triangle is supplied.
46*>
47*> This is an auxiliary routine called by DSYTRD.
48*> \endverbatim
49*
50* Arguments:
51* ==========
52*
53*> \param[in] UPLO
54*> \verbatim
55*> UPLO is CHARACTER*1
56*> Specifies whether the upper or lower triangular part of the
57*> symmetric matrix A is stored:
58*> = 'U': Upper triangular
59*> = 'L': Lower triangular
60*> \endverbatim
61*>
62*> \param[in] N
63*> \verbatim
64*> N is INTEGER
65*> The order of the matrix A.
66*> \endverbatim
67*>
68*> \param[in] NB
69*> \verbatim
70*> NB is INTEGER
71*> The number of rows and columns to be reduced.
72*> \endverbatim
73*>
74*> \param[in,out] A
75*> \verbatim
76*> A is DOUBLE PRECISION array, dimension (LDA,N)
77*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
78*> n-by-n upper triangular part of A contains the upper
79*> triangular part of the matrix A, and the strictly lower
80*> triangular part of A is not referenced. If UPLO = 'L', the
81*> leading n-by-n lower triangular part of A contains the lower
82*> triangular part of the matrix A, and the strictly upper
83*> triangular part of A is not referenced.
84*> On exit:
85*> if UPLO = 'U', the last NB columns have been reduced to
86*> tridiagonal form, with the diagonal elements overwriting
87*> the diagonal elements of A; the elements above the diagonal
88*> with the array TAU, represent the orthogonal matrix Q as a
89*> product of elementary reflectors;
90*> if UPLO = 'L', the first NB columns have been reduced to
91*> tridiagonal form, with the diagonal elements overwriting
92*> the diagonal elements of A; the elements below the diagonal
93*> with the array TAU, represent the orthogonal matrix Q as a
94*> product of elementary reflectors.
95*> See Further Details.
96*> \endverbatim
97*>
98*> \param[in] LDA
99*> \verbatim
100*> LDA is INTEGER
101*> The leading dimension of the array A. LDA >= (1,N).
102*> \endverbatim
103*>
104*> \param[out] E
105*> \verbatim
106*> E is DOUBLE PRECISION array, dimension (N-1)
107*> If UPLO = 'U', E(n-nb:n-1) contains the superdiagonal
108*> elements of the last NB columns of the reduced matrix;
109*> if UPLO = 'L', E(1:nb) contains the subdiagonal elements of
110*> the first NB columns of the reduced matrix.
111*> \endverbatim
112*>
113*> \param[out] TAU
114*> \verbatim
115*> TAU is DOUBLE PRECISION array, dimension (N-1)
116*> The scalar factors of the elementary reflectors, stored in
117*> TAU(n-nb:n-1) if UPLO = 'U', and in TAU(1:nb) if UPLO = 'L'.
118*> See Further Details.
119*> \endverbatim
120*>
121*> \param[out] W
122*> \verbatim
123*> W is DOUBLE PRECISION array, dimension (LDW,NB)
124*> The n-by-nb matrix W required to update the unreduced part
125*> of A.
126*> \endverbatim
127*>
128*> \param[in] LDW
129*> \verbatim
130*> LDW is INTEGER
131*> The leading dimension of the array W. LDW >= max(1,N).
132*> \endverbatim
133*
134* Authors:
135* ========
136*
137*> \author Univ. of Tennessee
138*> \author Univ. of California Berkeley
139*> \author Univ. of Colorado Denver
140*> \author NAG Ltd.
141*
142*> \ingroup latrd
143*
144*> \par Further Details:
145* =====================
146*>
147*> \verbatim
148*>
149*> If UPLO = 'U', the matrix Q is represented as a product of elementary
150*> reflectors
151*>
152*> Q = H(n) H(n-1) . . . H(n-nb+1).
153*>
154*> Each H(i) has the form
155*>
156*> H(i) = I - tau * v * v**T
157*>
158*> where tau is a real scalar, and v is a real vector with
159*> v(i:n) = 0 and v(i-1) = 1; v(1:i-1) is stored on exit in A(1:i-1,i),
160*> and tau in TAU(i-1).
161*>
162*> If UPLO = 'L', the matrix Q is represented as a product of elementary
163*> reflectors
164*>
165*> Q = H(1) H(2) . . . H(nb).
166*>
167*> Each H(i) has the form
168*>
169*> H(i) = I - tau * v * v**T
170*>
171*> where tau is a real scalar, and v is a real vector with
172*> v(1:i) = 0 and v(i+1) = 1; v(i+1:n) is stored on exit in A(i+1:n,i),
173*> and tau in TAU(i).
174*>
175*> The elements of the vectors v together form the n-by-nb matrix V
176*> which is needed, with W, to apply the transformation to the unreduced
177*> part of the matrix, using a symmetric rank-2k update of the form:
178*> A := A - V*W**T - W*V**T.
179*>
180*> The contents of A on exit are illustrated by the following examples
181*> with n = 5 and nb = 2:
182*>
183*> if UPLO = 'U': if UPLO = 'L':
184*>
185*> ( a a a v4 v5 ) ( d )
186*> ( a a v4 v5 ) ( 1 d )
187*> ( a 1 v5 ) ( v1 1 a )
188*> ( d 1 ) ( v1 v2 a a )
189*> ( d ) ( v1 v2 a a a )
190*>
191*> where d denotes a diagonal element of the reduced matrix, a denotes
192*> an element of the original matrix that is unchanged, and vi denotes
193*> an element of the vector defining H(i).
194*> \endverbatim
195*>
196* =====================================================================
197 SUBROUTINE dlatrd( UPLO, N, NB, A, LDA, E, TAU, W, LDW )
198*
199* -- LAPACK auxiliary routine --
200* -- LAPACK is a software package provided by Univ. of Tennessee, --
201* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
202*
203* .. Scalar Arguments ..
204 CHARACTER UPLO
205 INTEGER LDA, LDW, N, NB
206* ..
207* .. Array Arguments ..
208 DOUBLE PRECISION A( LDA, * ), E( * ), TAU( * ), W( LDW, * )
209* ..
210*
211* =====================================================================
212*
213* .. Parameters ..
214 DOUBLE PRECISION ZERO, ONE, HALF
215 parameter( zero = 0.0d+0, one = 1.0d+0, half = 0.5d+0 )
216* ..
217* .. Local Scalars ..
218 INTEGER I, IW
219 DOUBLE PRECISION ALPHA
220* ..
221* .. External Subroutines ..
222 EXTERNAL daxpy, dgemv, dlarfg, dscal, dsymv
223* ..
224* .. External Functions ..
225 LOGICAL LSAME
226 DOUBLE PRECISION DDOT
227 EXTERNAL lsame, ddot
228* ..
229* .. Intrinsic Functions ..
230 INTRINSIC min
231* ..
232* .. Executable Statements ..
233*
234* Quick return if possible
235*
236 IF( n.LE.0 )
237 $ RETURN
238*
239 IF( lsame( uplo, 'U' ) ) THEN
240*
241* Reduce last NB columns of upper triangle
242*
243 DO 10 i = n, n - nb + 1, -1
244 iw = i - n + nb
245 IF( i.LT.n ) THEN
246*
247* Update A(1:i,i)
248*
249 CALL dgemv( 'No transpose', i, n-i, -one, a( 1, i+1 ),
250 $ lda, w( i, iw+1 ), ldw, one, a( 1, i ), 1 )
251 CALL dgemv( 'No transpose', i, n-i, -one, w( 1, iw+1 ),
252 $ ldw, a( i, i+1 ), lda, one, a( 1, i ), 1 )
253 END IF
254 IF( i.GT.1 ) THEN
255*
256* Generate elementary reflector H(i) to annihilate
257* A(1:i-2,i)
258*
259 CALL dlarfg( i-1, a( i-1, i ), a( 1, i ), 1, tau( i-1 ) )
260 e( i-1 ) = a( i-1, i )
261 a( i-1, i ) = one
262*
263* Compute W(1:i-1,i)
264*
265 CALL dsymv( 'Upper', i-1, one, a, lda, a( 1, i ), 1,
266 $ zero, w( 1, iw ), 1 )
267 IF( i.LT.n ) THEN
268 CALL dgemv( 'Transpose', i-1, n-i, one, w( 1, iw+1 ),
269 $ ldw, a( 1, i ), 1, zero, w( i+1, iw ), 1 )
270 CALL dgemv( 'No transpose', i-1, n-i, -one,
271 $ a( 1, i+1 ), lda, w( i+1, iw ), 1, one,
272 $ w( 1, iw ), 1 )
273 CALL dgemv( 'Transpose', i-1, n-i, one, a( 1, i+1 ),
274 $ lda, a( 1, i ), 1, zero, w( i+1, iw ), 1 )
275 CALL dgemv( 'No transpose', i-1, n-i, -one,
276 $ w( 1, iw+1 ), ldw, w( i+1, iw ), 1, one,
277 $ w( 1, iw ), 1 )
278 END IF
279 CALL dscal( i-1, tau( i-1 ), w( 1, iw ), 1 )
280 alpha = -half*tau( i-1 )*ddot( i-1, w( 1, iw ), 1,
281 $ a( 1, i ), 1 )
282 CALL daxpy( i-1, alpha, a( 1, i ), 1, w( 1, iw ), 1 )
283 END IF
284*
285 10 CONTINUE
286 ELSE
287*
288* Reduce first NB columns of lower triangle
289*
290 DO 20 i = 1, nb
291*
292* Update A(i:n,i)
293*
294 CALL dgemv( 'No transpose', n-i+1, i-1, -one, a( i, 1 ),
295 $ lda, w( i, 1 ), ldw, one, a( i, i ), 1 )
296 CALL dgemv( 'No transpose', n-i+1, i-1, -one, w( i, 1 ),
297 $ ldw, a( i, 1 ), lda, one, a( i, i ), 1 )
298 IF( i.LT.n ) THEN
299*
300* Generate elementary reflector H(i) to annihilate
301* A(i+2:n,i)
302*
303 CALL dlarfg( n-i, a( i+1, i ), a( min( i+2, n ), i ), 1,
304 $ tau( i ) )
305 e( i ) = a( i+1, i )
306 a( i+1, i ) = one
307*
308* Compute W(i+1:n,i)
309*
310 CALL dsymv( 'Lower', n-i, one, a( i+1, i+1 ), lda,
311 $ a( i+1, i ), 1, zero, w( i+1, i ), 1 )
312 CALL dgemv( 'Transpose', n-i, i-1, one, w( i+1, 1 ), ldw,
313 $ a( i+1, i ), 1, zero, w( 1, i ), 1 )
314 CALL dgemv( 'No transpose', n-i, i-1, -one, a( i+1, 1 ),
315 $ lda, w( 1, i ), 1, one, w( i+1, i ), 1 )
316 CALL dgemv( 'Transpose', n-i, i-1, one, a( i+1, 1 ), lda,
317 $ a( i+1, i ), 1, zero, w( 1, i ), 1 )
318 CALL dgemv( 'No transpose', n-i, i-1, -one, w( i+1, 1 ),
319 $ ldw, w( 1, i ), 1, one, w( i+1, i ), 1 )
320 CALL dscal( n-i, tau( i ), w( i+1, i ), 1 )
321 alpha = -half*tau( i )*ddot( n-i, w( i+1, i ), 1,
322 $ a( i+1, i ), 1 )
323 CALL daxpy( n-i, alpha, a( i+1, i ), 1, w( i+1, i ), 1 )
324 END IF
325*
326 20 CONTINUE
327 END IF
328*
329 RETURN
330*
331* End of DLATRD
332*
333 END
subroutine daxpy(n, da, dx, incx, dy, incy)
DAXPY
Definition daxpy.f:89
subroutine dgemv(trans, m, n, alpha, a, lda, x, incx, beta, y, incy)
DGEMV
Definition dgemv.f:158
subroutine dsymv(uplo, n, alpha, a, lda, x, incx, beta, y, incy)
DSYMV
Definition dsymv.f:152
subroutine dlarfg(n, alpha, x, incx, tau)
DLARFG generates an elementary reflector (Householder matrix).
Definition dlarfg.f:106
subroutine dlatrd(uplo, n, nb, a, lda, e, tau, w, ldw)
DLATRD reduces the first nb rows and columns of a symmetric/Hermitian matrix A to real tridiagonal fo...
Definition dlatrd.f:198
subroutine dscal(n, da, dx, incx)
DSCAL
Definition dscal.f:79