1 SUBROUTINE dorgbr( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
10 INTEGER INFO, K, LDA, LWORK, M, N
13 DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
99 DOUBLE PRECISION ZERO, ONE
100 parameter( zero = 0.0d+0, one = 1.0d+0 )
103 LOGICAL LQUERY, WANTQ
104 INTEGER I, IINFO, J, LWKOPT, MN, NB
109 EXTERNAL lsame, ilaenv
122 wantq = lsame( vect,
'Q' )
124 lquery = ( lwork.EQ.-1 )
125 IF( .NOT.wantq .AND. .NOT.lsame( vect,
'P' ) )
THEN
127 ELSE IF( m.LT.0 )
THEN
129 ELSE IF( n.LT.0 .OR. ( wantq .AND. ( n.GT.m .OR. n.LT.min( m,
130 $ k ) ) ) .OR. ( .NOT.wantq .AND. ( m.GT.n .OR. m.LT.
131 $ min( n, k ) ) ) )
THEN
133 ELSE IF( k.LT.0 )
THEN
135 ELSE IF( lda.LT.max( 1, m ) )
THEN
137 ELSE IF( lwork.LT.max( 1, mn ) .AND. .NOT.lquery )
THEN
143 nb = ilaenv( 1,
'DORGQR',
' ', m, n, k, -1 )
145 nb = ilaenv( 1,
'DORGLQ',
' ', m, n, k, -1 )
147 lwkopt = max( 1, mn )*nb
152 CALL xerbla(
'DORGBR', -info )
154 ELSE IF( lquery )
THEN
160 IF( m.EQ.0 .OR. n.EQ.0 )
THEN
174 CALL dorgqr( m, n, k, a, lda, tau, work, lwork, iinfo )
187 a( i, j ) = a( i, j-1 )
198 CALL dorgqr( m-1, m-1, m-1, a( 2, 2 ), lda, tau, work,
211 CALL dorglq( m, n, k, a, lda, tau, work, lwork, iinfo )
226 DO 50 i = j - 1, 2, -1
227 a( i, j ) = a( i-1, j )
235 CALL dorglq( n-1, n-1, n-1, a( 2, 2 ), lda, tau, work,
subroutine dorgbr(VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
subroutine dorglq(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
subroutine dorgqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
subroutine xerbla(SRNAME, INFO)