1 SUBROUTINE dgehrd( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
9 INTEGER IHI, ILO, INFO, LDA, LWORK, N
12 DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
105 parameter( nbmax = 64, ldt = nbmax+1 )
106 DOUBLE PRECISION ZERO, ONE
107 parameter( zero = 0.0d+0, one = 1.0d+0 )
111 INTEGER I, IB, IINFO, IWS, LDWORK, LWKOPT, NB, NBMIN,
116 DOUBLE PRECISION T( LDT, NBMAX )
133 nb = min( nbmax, ilaenv( 1,
'DGEHRD',
' ', n, ilo, ihi, -1 ) )
136 lquery = ( lwork.EQ.-1 )
139 ELSE IF( ilo.LT.1 .OR. ilo.GT.max( 1, n ) )
THEN
141 ELSE IF( ihi.LT.min( ilo, n ) .OR. ihi.GT.n )
THEN
143 ELSE IF( lda.LT.max( 1, n ) )
THEN
145 ELSE IF( lwork.LT.max( 1, n ) .AND. .NOT.lquery )
THEN
149 CALL xerbla(
'DGEHRD', -info )
151 ELSE IF( lquery )
THEN
160 DO 20 i = max( 1, ihi ), n - 1
174 nb = min( nbmax, ilaenv( 1,
'DGEHRD',
' ', n, ilo, ihi, -1 ) )
177 IF( nb.GT.1 .AND. nb.LT.nh )
THEN
182 nx = max( nb, ilaenv( 3,
'DGEHRD',
' ', n, ilo, ihi, -1 ) )
188 IF( lwork.LT.iws )
THEN
194 nbmin = max( 2, ilaenv( 2,
'DGEHRD',
' ', n, ilo, ihi,
196 IF( lwork.GE.n*nbmin )
THEN
206 IF( nb.LT.nbmin .OR. nb.GE.nh )
THEN
216 DO 30 i = ilo, ihi - 1 - nx, nb
217 ib = min( nb, ihi-i )
223 CALL dlahrd( ihi, i, ib, a( 1, i ), lda, tau( i ), t, ldt,
230 ei = a( i+ib, i+ib-1 )
231 a( i+ib, i+ib-1 ) = one
232 CALL dgemm(
'No transpose',
'Transpose', ihi, ihi-i-ib+1,
233 $ ib, -one, work, ldwork, a( i+ib, i ), lda, one,
234 $ a( 1, i+ib ), lda )
235 a( i+ib, i+ib-1 ) = ei
240 CALL dlarfb(
'Left',
'Transpose',
'Forward',
'Columnwise',
241 $ ihi-i, n-i-ib+1, ib, a( i+1, i ), lda, t, ldt,
242 $ a( i+1, i+ib ), lda, work, ldwork )
248 CALL dgehd2( n, i, ihi, a, lda, tau, work, iinfo )
subroutine dgehd2(N, ILO, IHI, A, LDA, TAU, WORK, INFO)
subroutine dgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
subroutine dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
subroutine dlahrd(N, K, NB, A, LDA, TAU, T, LDT, Y, LDY)
subroutine dlarfb(SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, T, LDT, C, LDC, WORK, LDWORK)
subroutine xerbla(SRNAME, INFO)