1 SUBROUTINE dorgql( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
9 INTEGER INFO, K, LDA, LWORK, M, N
12 DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
74 parameter( zero = 0.0d+0 )
78 INTEGER I, IB, IINFO, IWS, J, KK, L, LDWORK, LWKOPT,
96 nb = ilaenv( 1,
'DORGQL',
' ', m, n, k, -1 )
97 lwkopt = max( 1, n )*nb
99 lquery = ( lwork.EQ.-1 )
102 ELSE IF( n.LT.0 .OR. n.GT.m )
THEN
104 ELSE IF( k.LT.0 .OR. k.GT.n )
THEN
106 ELSE IF( lda.LT.max( 1, m ) )
THEN
108 ELSE IF( lwork.LT.max( 1, n ) .AND. .NOT.lquery )
THEN
112 CALL xerbla(
'DORGQL', -info )
114 ELSE IF( lquery )
THEN
128 IF( nb.GT.1 .AND. nb.LT.k )
THEN
132 nx = max( 0, ilaenv( 3,
'DORGQL',
' ', m, n, k, -1 ) )
139 IF( lwork.LT.iws )
THEN
145 nbmin = max( 2, ilaenv( 2,
'DORGQL',
' ', m, n, k, -1 ) )
150 IF( nb.GE.nbmin .AND. nb.LT.k .AND. nx.LT.k )
THEN
155 kk = min( k, ( ( k-nx+nb-1 ) / nb )*nb )
160 DO 10 i = m - kk + 1, m
170 CALL dorg2l( m-kk, n-kk, k-kk, a, lda, tau, work, iinfo )
176 DO 50 i = k - kk + 1, k, nb
177 ib = min( nb, k-i+1 )
178 IF( n-k+i.GT.1 )
THEN
183 CALL dlarft(
'Backward',
'Columnwise', m-k+i+ib-1, ib,
184 $ a( 1, n-k+i ), lda, tau( i ), work, ldwork )
188 CALL dlarfb(
'Left',
'No transpose',
'Backward',
189 $
'Columnwise', m-k+i+ib-1, n-k+i-1, ib,
190 $ a( 1, n-k+i ), lda, work, ldwork, a, lda,
191 $ work( ib+1 ), ldwork )
196 CALL dorg2l( m-k+i+ib-1, ib, ib, a( 1, n-k+i ), lda,
197 $ tau( i ), work, iinfo )
201 DO 40 j = n - k + i, n - k + i + ib - 1
202 DO 30 l = m - k + i + ib, m
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 dorg2l(M, N, K, A, LDA, TAU, WORK, INFO)
subroutine dorgql(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
subroutine xerbla(SRNAME, INFO)