1 SUBROUTINE dormqr( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
11 INTEGER INFO, K, LDA, LDC, LWORK, M, N
14 DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
103 parameter( nbmax = 64, ldt = nbmax+1 )
106 LOGICAL LEFT, LQUERY, NOTRAN
107 INTEGER I, I1, I2, I3, IB, IC, IINFO, IWS, JC, LDWORK,
108 $ lwkopt, mi, nb, nbmin, ni, nq, nw
111 DOUBLE PRECISION T( LDT, NBMAX )
116 EXTERNAL lsame, ilaenv
129 left = lsame( side,
'L' )
130 notran = lsame( trans,
'N' )
131 lquery = ( lwork.EQ.-1 )
142 IF( .NOT.left .AND. .NOT.lsame( side,
'R' ) )
THEN
144 ELSE IF( .NOT.notran .AND. .NOT.lsame( trans,
'T' ) )
THEN
146 ELSE IF( m.LT.0 )
THEN
148 ELSE IF( n.LT.0 )
THEN
150 ELSE IF( k.LT.0 .OR. k.GT.nq )
THEN
152 ELSE IF( lda.LT.max( 1, nq ) )
THEN
154 ELSE IF( ldc.LT.max( 1, m ) )
THEN
156 ELSE IF( lwork.LT.max( 1, nw ) .AND. .NOT.lquery )
THEN
165 nb = min( nbmax, ilaenv( 1,
'DORMQR', side // trans, m, n, k,
167 lwkopt = max( 1, nw )*nb
172 CALL xerbla(
'DORMQR', -info )
174 ELSE IF( lquery )
THEN
180 IF( m.EQ.0 .OR. n.EQ.0 .OR. k.EQ.0 )
THEN
187 IF( nb.GT.1 .AND. nb.LT.k )
THEN
189 IF( lwork.LT.iws )
THEN
191 nbmin = max( 2, ilaenv( 2,
'DORMQR', side // trans, m, n, k,
198 IF( nb.LT.nbmin .OR. nb.GE.k )
THEN
202 CALL dorm2r( side, trans, m, n, k, a, lda, tau, c, ldc, work,
208 IF( ( left .AND. .NOT.notran ) .OR.
209 $ ( .NOT.left .AND. notran ) )
THEN
214 i1 = ( ( k-1 ) / nb )*nb + 1
228 ib = min( nb, k-i+1 )
233 CALL dlarft(
'Forward',
'Columnwise', nq-i+1, ib, a( i, i ),
234 $ lda, tau( i ), t, ldt )
251 CALL dlarfb( side, trans,
'Forward',
'Columnwise', mi, ni,
252 $ ib, a( i, i ), lda, t, ldt, c( ic, jc ), ldc,
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 dorm2r(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, INFO)
subroutine dormqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
subroutine xerbla(SRNAME, INFO)