1 SUBROUTINE dorglq( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
9 INTEGER INFO, K, LDA, LWORK, M, N
12 DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
73 parameter( zero = 0.0d+0 )
77 INTEGER I, IB, IINFO, IWS, J, KI, KK, L, LDWORK,
78 $ LWKOPT, NB, NBMIN, NX
95 nb = ilaenv( 1,
'DORGLQ',
' ', m, n, k, -1 )
96 lwkopt = max( 1, m )*nb
98 lquery = ( lwork.EQ.-1 )
101 ELSE IF( n.LT.m )
THEN
103 ELSE IF( k.LT.0 .OR. k.GT.m )
THEN
105 ELSE IF( lda.LT.max( 1, m ) )
THEN
107 ELSE IF( lwork.LT.max( 1, m ) .AND. .NOT.lquery )
THEN
111 CALL xerbla(
'DORGLQ', -info )
113 ELSE IF( lquery )
THEN
127 IF( nb.GT.1 .AND. nb.LT.k )
THEN
131 nx = max( 0, ilaenv( 3,
'DORGLQ',
' ', m, n, k, -1 ) )
138 IF( lwork.LT.iws )
THEN
144 nbmin = max( 2, ilaenv( 2,
'DORGLQ',
' ', m, n, k, -1 ) )
149 IF( nb.GE.nbmin .AND. nb.LT.k .AND. nx.LT.k )
THEN
154 ki = ( ( k-nx-1 ) / nb )*nb
171 $
CALL dorgl2( m-kk, n-kk, k-kk, a( kk+1, kk+1 ), lda,
172 $ tau( kk+1 ), work, iinfo )
178 DO 50 i = ki + 1, 1, -nb
179 ib = min( nb, k-i+1 )
185 CALL dlarft(
'Forward',
'Rowwise', n-i+1, ib, a( i, i ),
186 $ lda, tau( i ), work, ldwork )
190 CALL dlarfb(
'Right',
'Transpose',
'Forward',
'Rowwise',
191 $ m-i-ib+1, n-i+1, ib, a( i, i ), lda, work,
192 $ ldwork, a( i+ib, i ), lda, work( ib+1 ),
198 CALL dorgl2( ib, n-i+1, ib, a( i, i ), lda, tau( i ), work,
204 DO 30 l = i, i + ib - 1
subroutine dlarfb(SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, T, LDT, C, LDC, WORK, LDWORK)
subroutine dlarft(DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT)
subroutine dorgl2(M, N, K, A, LDA, TAU, WORK, INFO)
subroutine dorglq(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
subroutine xerbla(SRNAME, INFO)