158 SUBROUTINE dorgbr( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
167 INTEGER info, k, lda, lwork, m, n
170 DOUBLE PRECISION a( lda, * ), tau( * ), work( * )
176 DOUBLE PRECISION zero, one
177 parameter( zero = 0.0d+0, one = 1.0d+0 )
180 LOGICAL lquery, wantq
181 INTEGER i, iinfo,
j, lwkopt, mn
199 wantq =
lsame( vect,
'Q' )
201 lquery = ( lwork.EQ.-1 )
202 IF( .NOT.wantq .AND. .NOT.
lsame( vect,
'P' ) )
THEN
204 ELSE IF( m.LT.0 )
THEN
206 ELSE IF( n.LT.0 .OR. ( wantq .AND. ( n.GT.m .OR. n.LT.min( m,
207 $ k ) ) ) .OR. ( .NOT.wantq .AND. ( m.GT.n .OR. m.LT.
208 $ min( n, k ) ) ) )
THEN
210 ELSE IF( k.LT.0 )
THEN
212 ELSE IF( lda.LT.max( 1, m ) )
THEN
214 ELSE IF( lwork.LT.max( 1, mn ) .AND. .NOT.lquery )
THEN
222 CALL
dorgqr( m, n, k, a, lda, tau, work, -1, iinfo )
225 CALL
dorgqr( m-1, m-1, m-1, a( 2, 2 ), lda, tau, work,
231 CALL
dorglq( m, n, k, a, lda, tau, work, -1, iinfo )
234 CALL
dorglq( n-1, n-1, n-1, a( 2, 2 ), lda, tau, work,
240 lwkopt = max(lwkopt, mn)
244 CALL
xerbla(
'DORGBR', -info )
246 ELSE IF( lquery )
THEN
253 IF( m.EQ.0 .OR. n.EQ.0 )
THEN
267 CALL
dorgqr( m, n, k, a, lda, tau, work, lwork, iinfo )
280 a( i,
j ) = a( i,
j-1 )
291 CALL
dorgqr( m-1, m-1, m-1, a( 2, 2 ), lda, tau, work,
304 CALL
dorglq( m, n, k, a, lda, tau, work, lwork, iinfo )
319 DO 50 i =
j - 1, 2, -1
320 a( i,
j ) = a( i-1,
j )
328 CALL
dorglq( n-1, n-1, n-1, a( 2, 2 ), lda, tau, work,
subroutine dorglq(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
DORGLQ
subroutine xerbla(SRNAME, INFO)
XERBLA
logical function lsame(CA, CB)
LSAME
subroutine dorgqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
DORGQR
subroutine dorgbr(VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
DORGBR
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)