1 SUBROUTINE dgebrd( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK,
10 INTEGER INFO, LDA, LWORK, M, N
13 DOUBLE PRECISION A( LDA, * ), D( * ), E( * ), TAUP( * ),
14 $ tauq( * ), work( * )
141 parameter( one = 1.0d+0 )
145 INTEGER I, IINFO, J, LDWRKX, LDWRKY, LWKOPT, MINMN, NB,
153 INTRINSIC dble, max, min
164 nb = max( 1, ilaenv( 1,
'DGEBRD',
' ', m, n, -1, -1 ) )
166 work( 1 ) = dble( lwkopt )
167 lquery = ( lwork.EQ.-1 )
170 ELSE IF( n.LT.0 )
THEN
172 ELSE IF( lda.LT.max( 1, m ) )
THEN
174 ELSE IF( lwork.LT.max( 1, m, n ) .AND. .NOT.lquery )
THEN
178 CALL xerbla(
'DGEBRD', -info )
180 ELSE IF( lquery )
THEN
187 IF( minmn.EQ.0 )
THEN
196 IF( nb.GT.1 .AND. nb.LT.minmn )
THEN
200 nx = max( nb, ilaenv( 3,
'DGEBRD',
' ', m, n, -1, -1 ) )
204 IF( nx.LT.minmn )
THEN
206 IF( lwork.LT.ws )
THEN
211 nbmin = ilaenv( 2,
'DGEBRD',
' ', m, n, -1, -1 )
212 IF( lwork.GE.( m+n )*nbmin )
THEN
224 DO 30 i = 1, minmn - nx, nb
230 CALL dlabrd( m-i+1, n-i+1, nb, a( i, i ), lda, d( i ), e( i ),
231 $ tauq( i ), taup( i ), work, ldwrkx,
232 $ work( ldwrkx*nb+1 ), ldwrky )
237 CALL dgemm(
'No transpose',
'Transpose', m-i-nb+1, n-i-nb+1,
238 $ nb, -one, a( i+nb, i ), lda,
239 $ work( ldwrkx*nb+nb+1 ), ldwrky, one,
240 $ a( i+nb, i+nb ), lda )
241 CALL dgemm(
'No transpose',
'No transpose', m-i-nb+1, n-i-nb+1,
242 $ nb, -one, work( nb+1 ), ldwrkx, a( i, i+nb ), lda,
243 $ one, a( i+nb, i+nb ), lda )
248 DO 10 j = i, i + nb - 1
253 DO 20 j = i, i + nb - 1
262 CALL dgebd2( m-i+1, n-i+1, a( i, i ), lda, d( i ), e( i ),
263 $ tauq( i ), taup( i ), work, iinfo )
subroutine dgebd2(M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO)
subroutine dgebrd(M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, INFO)
subroutine dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
subroutine dlabrd(M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y, LDY)
subroutine xerbla(SRNAME, INFO)