129 SUBROUTINE zungqr( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
137 INTEGER info, k, lda, lwork, m, n
140 COMPLEX*16 a( lda, * ), tau( * ), work( * )
147 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
151 INTEGER i, ib, iinfo, iws,
j, ki, kk, l, ldwork,
152 $ lwkopt, nb, nbmin, nx
169 nb =
ilaenv( 1,
'ZUNGQR',
' ', m, n, k, -1 )
170 lwkopt = max( 1, n )*nb
172 lquery = ( lwork.EQ.-1 )
175 ELSE IF( n.LT.0 .OR. n.GT.m )
THEN
177 ELSE IF( k.LT.0 .OR. k.GT.n )
THEN
179 ELSE IF( lda.LT.max( 1, m ) )
THEN
181 ELSE IF( lwork.LT.max( 1, n ) .AND. .NOT.lquery )
THEN
185 CALL
xerbla(
'ZUNGQR', -info )
187 ELSE IF( lquery )
THEN
201 IF( nb.GT.1 .AND. nb.LT.k )
THEN
205 nx = max( 0,
ilaenv( 3,
'ZUNGQR',
' ', m, n, k, -1 ) )
212 IF( lwork.LT.iws )
THEN
218 nbmin = max( 2,
ilaenv( 2,
'ZUNGQR',
' ', m, n, k, -1 ) )
223 IF( nb.GE.nbmin .AND. nb.LT.k .AND. nx.LT.k )
THEN
228 ki = ( ( k-nx-1 ) / nb )*nb
245 $ CALL
zung2r( m-kk, n-kk, k-kk, a( kk+1, kk+1 ), lda,
246 $ tau( kk+1 ), work, iinfo )
252 DO 50 i = ki + 1, 1, -nb
253 ib = min( nb, k-i+1 )
259 CALL
zlarft(
'Forward',
'Columnwise', m-i+1, ib,
260 $ a( i, i ), lda, tau( i ), work, ldwork )
264 CALL
zlarfb(
'Left',
'No transpose',
'Forward',
265 $
'Columnwise', m-i+1, n-i-ib+1, ib,
266 $ a( i, i ), lda, work, ldwork, a( i, i+ib ),
267 $ lda, work( ib+1 ), ldwork )
272 CALL
zung2r( m-i+1, ib, ib, a( i, i ), lda, tau( i ), work,
277 DO 40
j = i, i + ib - 1
subroutine zlarfb(SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, T, LDT, C, LDC, WORK, LDWORK)
ZLARFB applies a block reflector or its conjugate-transpose to a general rectangular matrix...
subroutine zungqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGQR
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zlarft(DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT)
ZLARFT forms the triangular factor T of a block reflector H = I - vtvH
INTEGER function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine zung2r(M, N, K, A, LDA, TAU, WORK, INFO)
ZUNG2R