LAPACK  3.7.1
LAPACK: Linear Algebra PACKage
sgebrd.f
Go to the documentation of this file.
1 *> \brief \b SGEBRD
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download SGEBRD + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgebrd.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgebrd.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgebrd.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE SGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK,
22 * INFO )
23 *
24 * .. Scalar Arguments ..
25 * INTEGER INFO, LDA, LWORK, M, N
26 * ..
27 * .. Array Arguments ..
28 * REAL A( LDA, * ), D( * ), E( * ), TAUP( * ),
29 * $ TAUQ( * ), WORK( * )
30 * ..
31 *
32 *
33 *> \par Purpose:
34 * =============
35 *>
36 *> \verbatim
37 *>
38 *> SGEBRD reduces a general real M-by-N matrix A to upper or lower
39 *> bidiagonal form B by an orthogonal transformation: Q**T * A * P = B.
40 *>
41 *> If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal.
42 *> \endverbatim
43 *
44 * Arguments:
45 * ==========
46 *
47 *> \param[in] M
48 *> \verbatim
49 *> M is INTEGER
50 *> The number of rows in the matrix A. M >= 0.
51 *> \endverbatim
52 *>
53 *> \param[in] N
54 *> \verbatim
55 *> N is INTEGER
56 *> The number of columns in the matrix A. N >= 0.
57 *> \endverbatim
58 *>
59 *> \param[in,out] A
60 *> \verbatim
61 *> A is REAL array, dimension (LDA,N)
62 *> On entry, the M-by-N general matrix to be reduced.
63 *> On exit,
64 *> if m >= n, the diagonal and the first superdiagonal are
65 *> overwritten with the upper bidiagonal matrix B; the
66 *> elements below the diagonal, with the array TAUQ, represent
67 *> the orthogonal matrix Q as a product of elementary
68 *> reflectors, and the elements above the first superdiagonal,
69 *> with the array TAUP, represent the orthogonal matrix P as
70 *> a product of elementary reflectors;
71 *> if m < n, the diagonal and the first subdiagonal are
72 *> overwritten with the lower bidiagonal matrix B; the
73 *> elements below the first subdiagonal, with the array TAUQ,
74 *> represent the orthogonal matrix Q as a product of
75 *> elementary reflectors, and the elements above the diagonal,
76 *> with the array TAUP, represent the orthogonal matrix P as
77 *> a product of elementary reflectors.
78 *> See Further Details.
79 *> \endverbatim
80 *>
81 *> \param[in] LDA
82 *> \verbatim
83 *> LDA is INTEGER
84 *> The leading dimension of the array A. LDA >= max(1,M).
85 *> \endverbatim
86 *>
87 *> \param[out] D
88 *> \verbatim
89 *> D is REAL array, dimension (min(M,N))
90 *> The diagonal elements of the bidiagonal matrix B:
91 *> D(i) = A(i,i).
92 *> \endverbatim
93 *>
94 *> \param[out] E
95 *> \verbatim
96 *> E is REAL array, dimension (min(M,N)-1)
97 *> The off-diagonal elements of the bidiagonal matrix B:
98 *> if m >= n, E(i) = A(i,i+1) for i = 1,2,...,n-1;
99 *> if m < n, E(i) = A(i+1,i) for i = 1,2,...,m-1.
100 *> \endverbatim
101 *>
102 *> \param[out] TAUQ
103 *> \verbatim
104 *> TAUQ is REAL array, dimension (min(M,N))
105 *> The scalar factors of the elementary reflectors which
106 *> represent the orthogonal matrix Q. See Further Details.
107 *> \endverbatim
108 *>
109 *> \param[out] TAUP
110 *> \verbatim
111 *> TAUP is REAL array, dimension (min(M,N))
112 *> The scalar factors of the elementary reflectors which
113 *> represent the orthogonal matrix P. See Further Details.
114 *> \endverbatim
115 *>
116 *> \param[out] WORK
117 *> \verbatim
118 *> WORK is REAL array, dimension (MAX(1,LWORK))
119 *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
120 *> \endverbatim
121 *>
122 *> \param[in] LWORK
123 *> \verbatim
124 *> LWORK is INTEGER
125 *> The length of the array WORK. LWORK >= max(1,M,N).
126 *> For optimum performance LWORK >= (M+N)*NB, where NB
127 *> is the optimal blocksize.
128 *>
129 *> If LWORK = -1, then a workspace query is assumed; the routine
130 *> only calculates the optimal size of the WORK array, returns
131 *> this value as the first entry of the WORK array, and no error
132 *> message related to LWORK is issued by XERBLA.
133 *> \endverbatim
134 *>
135 *> \param[out] INFO
136 *> \verbatim
137 *> INFO is INTEGER
138 *> = 0: successful exit
139 *> < 0: if INFO = -i, the i-th argument had an illegal value.
140 *> \endverbatim
141 *
142 * Authors:
143 * ========
144 *
145 *> \author Univ. of Tennessee
146 *> \author Univ. of California Berkeley
147 *> \author Univ. of Colorado Denver
148 *> \author NAG Ltd.
149 *
150 *> \date June 2017
151 *
152 *> \ingroup realGEcomputational
153 *
154 *> \par Further Details:
155 * =====================
156 *>
157 *> \verbatim
158 *>
159 *> The matrices Q and P are represented as products of elementary
160 *> reflectors:
161 *>
162 *> If m >= n,
163 *>
164 *> Q = H(1) H(2) . . . H(n) and P = G(1) G(2) . . . G(n-1)
165 *>
166 *> Each H(i) and G(i) has the form:
167 *>
168 *> H(i) = I - tauq * v * v**T and G(i) = I - taup * u * u**T
169 *>
170 *> where tauq and taup are real scalars, and v and u are real vectors;
171 *> v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in A(i+1:m,i);
172 *> u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in A(i,i+2:n);
173 *> tauq is stored in TAUQ(i) and taup in TAUP(i).
174 *>
175 *> If m < n,
176 *>
177 *> Q = H(1) H(2) . . . H(m-1) and P = G(1) G(2) . . . G(m)
178 *>
179 *> Each H(i) and G(i) has the form:
180 *>
181 *> H(i) = I - tauq * v * v**T and G(i) = I - taup * u * u**T
182 *>
183 *> where tauq and taup are real scalars, and v and u are real vectors;
184 *> v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in A(i+2:m,i);
185 *> u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in A(i,i+1:n);
186 *> tauq is stored in TAUQ(i) and taup in TAUP(i).
187 *>
188 *> The contents of A on exit are illustrated by the following examples:
189 *>
190 *> m = 6 and n = 5 (m > n): m = 5 and n = 6 (m < n):
191 *>
192 *> ( d e u1 u1 u1 ) ( d u1 u1 u1 u1 u1 )
193 *> ( v1 d e u2 u2 ) ( e d u2 u2 u2 u2 )
194 *> ( v1 v2 d e u3 ) ( v1 e d u3 u3 u3 )
195 *> ( v1 v2 v3 d e ) ( v1 v2 e d u4 u4 )
196 *> ( v1 v2 v3 v4 d ) ( v1 v2 v3 e d u5 )
197 *> ( v1 v2 v3 v4 v5 )
198 *>
199 *> where d and e denote diagonal and off-diagonal elements of B, vi
200 *> denotes an element of the vector defining H(i), and ui an element of
201 *> the vector defining G(i).
202 *> \endverbatim
203 *>
204 * =====================================================================
205  SUBROUTINE sgebrd( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK,
206  $ INFO )
207 *
208 * -- LAPACK computational routine (version 3.7.1) --
209 * -- LAPACK is a software package provided by Univ. of Tennessee, --
210 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
211 * June 2017
212 *
213 * .. Scalar Arguments ..
214  INTEGER INFO, LDA, LWORK, M, N
215 * ..
216 * .. Array Arguments ..
217  REAL A( lda, * ), D( * ), E( * ), TAUP( * ),
218  $ tauq( * ), work( * )
219 * ..
220 *
221 * =====================================================================
222 *
223 * .. Parameters ..
224  REAL ONE
225  parameter( one = 1.0e+0 )
226 * ..
227 * .. Local Scalars ..
228  LOGICAL LQUERY
229  INTEGER I, IINFO, J, LDWRKX, LDWRKY, LWKOPT, MINMN, NB,
230  $ nbmin, nx
231  REAL WS
232 * ..
233 * .. External Subroutines ..
234  EXTERNAL sgebd2, sgemm, slabrd, xerbla
235 * ..
236 * .. Intrinsic Functions ..
237  INTRINSIC max, min, real
238 * ..
239 * .. External Functions ..
240  INTEGER ILAENV
241  EXTERNAL ilaenv
242 * ..
243 * .. Executable Statements ..
244 *
245 * Test the input parameters
246 *
247  info = 0
248  nb = max( 1, ilaenv( 1, 'SGEBRD', ' ', m, n, -1, -1 ) )
249  lwkopt = ( m+n )*nb
250  work( 1 ) = REAL( lwkopt )
251  lquery = ( lwork.EQ.-1 )
252  IF( m.LT.0 ) THEN
253  info = -1
254  ELSE IF( n.LT.0 ) THEN
255  info = -2
256  ELSE IF( lda.LT.max( 1, m ) ) THEN
257  info = -4
258  ELSE IF( lwork.LT.max( 1, m, n ) .AND. .NOT.lquery ) THEN
259  info = -10
260  END IF
261  IF( info.LT.0 ) THEN
262  CALL xerbla( 'SGEBRD', -info )
263  RETURN
264  ELSE IF( lquery ) THEN
265  RETURN
266  END IF
267 *
268 * Quick return if possible
269 *
270  minmn = min( m, n )
271  IF( minmn.EQ.0 ) THEN
272  work( 1 ) = 1
273  RETURN
274  END IF
275 *
276  ws = max( m, n )
277  ldwrkx = m
278  ldwrky = n
279 *
280  IF( nb.GT.1 .AND. nb.LT.minmn ) THEN
281 *
282 * Set the crossover point NX.
283 *
284  nx = max( nb, ilaenv( 3, 'SGEBRD', ' ', m, n, -1, -1 ) )
285 *
286 * Determine when to switch from blocked to unblocked code.
287 *
288  IF( nx.LT.minmn ) THEN
289  ws = ( m+n )*nb
290  IF( lwork.LT.ws ) THEN
291 *
292 * Not enough work space for the optimal NB, consider using
293 * a smaller block size.
294 *
295  nbmin = ilaenv( 2, 'SGEBRD', ' ', m, n, -1, -1 )
296  IF( lwork.GE.( m+n )*nbmin ) THEN
297  nb = lwork / ( m+n )
298  ELSE
299  nb = 1
300  nx = minmn
301  END IF
302  END IF
303  END IF
304  ELSE
305  nx = minmn
306  END IF
307 *
308  DO 30 i = 1, minmn - nx, nb
309 *
310 * Reduce rows and columns i:i+nb-1 to bidiagonal form and return
311 * the matrices X and Y which are needed to update the unreduced
312 * part of the matrix
313 *
314  CALL slabrd( m-i+1, n-i+1, nb, a( i, i ), lda, d( i ), e( i ),
315  $ tauq( i ), taup( i ), work, ldwrkx,
316  $ work( ldwrkx*nb+1 ), ldwrky )
317 *
318 * Update the trailing submatrix A(i+nb:m,i+nb:n), using an update
319 * of the form A := A - V*Y**T - X*U**T
320 *
321  CALL sgemm( 'No transpose', 'Transpose', m-i-nb+1, n-i-nb+1,
322  $ nb, -one, a( i+nb, i ), lda,
323  $ work( ldwrkx*nb+nb+1 ), ldwrky, one,
324  $ a( i+nb, i+nb ), lda )
325  CALL sgemm( 'No transpose', 'No transpose', m-i-nb+1, n-i-nb+1,
326  $ nb, -one, work( nb+1 ), ldwrkx, a( i, i+nb ), lda,
327  $ one, a( i+nb, i+nb ), lda )
328 *
329 * Copy diagonal and off-diagonal elements of B back into A
330 *
331  IF( m.GE.n ) THEN
332  DO 10 j = i, i + nb - 1
333  a( j, j ) = d( j )
334  a( j, j+1 ) = e( j )
335  10 CONTINUE
336  ELSE
337  DO 20 j = i, i + nb - 1
338  a( j, j ) = d( j )
339  a( j+1, j ) = e( j )
340  20 CONTINUE
341  END IF
342  30 CONTINUE
343 *
344 * Use unblocked code to reduce the remainder of the matrix
345 *
346  CALL sgebd2( m-i+1, n-i+1, a( i, i ), lda, d( i ), e( i ),
347  $ tauq( i ), taup( i ), work, iinfo )
348  work( 1 ) = ws
349  RETURN
350 *
351 * End of SGEBRD
352 *
353  END
sgebrd
subroutine sgebrd(M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, INFO)
SGEBRD
Definition: sgebrd.f:207
sgebd2
subroutine sgebd2(M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO)
SGEBD2 reduces a general matrix to bidiagonal form using an unblocked algorithm.
Definition: sgebd2.f:191
sgemm
subroutine sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM
Definition: sgemm.f:189
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
slabrd
subroutine slabrd(M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y, LDY)
SLABRD reduces the first nb rows and columns of a general matrix to a bidiagonal form.
Definition: slabrd.f:212