1SLABRD(1) LAPACK auxiliary routine (version 3.1) SLABRD(1)
2
3
4
6 SLABRD - the first NB rows and columns of a real general m by n matrix
7 A to upper or lower bidiagonal form by an orthogonal transformation Q'
8 * A * P, and returns the matrices X and Y which are needed to apply the
9 transformation to the unreduced part of A
10
12 SUBROUTINE SLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y, LDY )
13
14 INTEGER LDA, LDX, LDY, M, N, NB
15
16 REAL A( LDA, * ), D( * ), E( * ), TAUP( * ), TAUQ( * ),
17 X( LDX, * ), Y( LDY, * )
18
20 SLABRD reduces the first NB rows and columns of a real general m by n
21 matrix A to upper or lower bidiagonal form by an orthogonal transforma‐
22 tion Q' * A * P, and returns the matrices X and Y which are needed to
23 apply the transformation to the unreduced part of A.
24
25 If m >= n, A is reduced to upper bidiagonal form; if m < n, to lower
26 bidiagonal form.
27
28 This is an auxiliary routine called by SGEBRD
29
30
32 M (input) INTEGER
33 The number of rows in the matrix A.
34
35 N (input) INTEGER
36 The number of columns in the matrix A.
37
38 NB (input) INTEGER
39 The number of leading rows and columns of A to be reduced.
40
41 A (input/output) REAL array, dimension (LDA,N)
42 On entry, the m by n general matrix to be reduced. On exit,
43 the first NB rows and columns of the matrix are overwritten;
44 the rest of the array is unchanged. If m >= n, elements on and
45 below the diagonal in the first NB columns, with the array
46 TAUQ, represent the orthogonal matrix Q as a product of elemen‐
47 tary reflectors; and elements above the diagonal in the first
48 NB rows, with the array TAUP, represent the orthogonal matrix P
49 as a product of elementary reflectors. If m < n, elements
50 below the diagonal in the first NB columns, with the array
51 TAUQ, represent the orthogonal matrix Q as a product of elemen‐
52 tary reflectors, and elements on and above the diagonal in the
53 first NB rows, with the array TAUP, represent the orthogonal
54 matrix P as a product of elementary reflectors. See Further
55 Details. LDA (input) INTEGER The leading dimension of the
56 array A. LDA >= max(1,M).
57
58 D (output) REAL array, dimension (NB)
59 The diagonal elements of the first NB rows and columns of the
60 reduced matrix. D(i) = A(i,i).
61
62 E (output) REAL array, dimension (NB)
63 The off-diagonal elements of the first NB rows and columns of
64 the reduced matrix.
65
66 TAUQ (output) REAL array dimension (NB)
67 The scalar factors of the elementary reflectors which represent
68 the orthogonal matrix Q. See Further Details. TAUP (output)
69 REAL array, dimension (NB) The scalar factors of the elementary
70 reflectors which represent the orthogonal matrix P. See Further
71 Details. X (output) REAL array, dimension (LDX,NB) The
72 m-by-nb matrix X required to update the unreduced part of A.
73
74 LDX (input) INTEGER
75 The leading dimension of the array X. LDX >= M.
76
77 Y (output) REAL array, dimension (LDY,NB)
78 The n-by-nb matrix Y required to update the unreduced part of
79 A.
80
81 LDY (input) INTEGER
82 The leading dimension of the array Y. LDY >= N.
83
85 The matrices Q and P are represented as products of elementary reflec‐
86 tors:
87
88 Q = H(1) H(2) . . . H(nb) and P = G(1) G(2) . . . G(nb)
89
90 Each H(i) and G(i) has the form:
91
92 H(i) = I - tauq * v * v' and G(i) = I - taup * u * u'
93
94 where tauq and taup are real scalars, and v and u are real vectors.
95
96 If m >= n, v(1:i-1) = 0, v(i) = 1, and v(i:m) is stored on exit in
97 A(i:m,i); u(1:i) = 0, u(i+1) = 1, and u(i+1:n) is stored on exit in
98 A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i).
99
100 If m < n, v(1:i) = 0, v(i+1) = 1, and v(i+1:m) is stored on exit in
101 A(i+2:m,i); u(1:i-1) = 0, u(i) = 1, and u(i:n) is stored on exit in
102 A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i).
103
104 The elements of the vectors v and u together form the m-by-nb matrix V
105 and the nb-by-n matrix U' which are needed, with X and Y, to apply the
106 transformation to the unreduced part of the matrix, using a block
107 update of the form: A := A - V*Y' - X*U'.
108
109 The contents of A on exit are illustrated by the following examples
110 with nb = 2:
111
112 m = 6 and n = 5 (m > n): m = 5 and n = 6 (m < n):
113
114 ( 1 1 u1 u1 u1 ) ( 1 u1 u1 u1 u1 u1 )
115 ( v1 1 1 u2 u2 ) ( 1 1 u2 u2 u2 u2 )
116 ( v1 v2 a a a ) ( v1 1 a a a a )
117 ( v1 v2 a a a ) ( v1 v2 a a a a )
118 ( v1 v2 a a a ) ( v1 v2 a a a a )
119 ( v1 v2 a a a )
120
121 where a denotes an element of the original matrix which is unchanged,
122 vi denotes an element of the vector defining H(i), and ui an element of
123 the vector defining G(i).
124
125
126
127
128 LAPACK auxiliary routine (versionNo3v.e1m)ber 2006 SLABRD(1)