115 RECURSIVE SUBROUTINE cgelqt3( M, N, A, LDA, T, LDT, INFO )
122 INTEGER info, lda, m, n, ldt
125 COMPLEX a( lda, * ), t( ldt, * )
132 parameter( one = (1.0e+00,0.0e+00) )
133 parameter( zero = (0.0e+00,0.0e+00))
136 INTEGER i, i1, j, j1, m1, m2, iinfo
146 ELSE IF( n .LT. m )
THEN
148 ELSE IF( lda .LT. max( 1, m ) )
THEN
150 ELSE IF( ldt .LT. max( 1, m ) )
THEN
154 CALL xerbla(
'CGELQT3', -info )
162 CALL clarfg( n, a, a( 1, min( 2, n ) ), lda, t )
176 CALL cgelqt3( m1, n, a, lda, t, ldt, iinfo )
182 t( i+m1, j ) = a( i+m1, j )
185 CALL ctrmm(
'R',
'U',
'C',
'U', m2, m1, one,
186 & a, lda, t( i1, 1 ), ldt )
188 CALL cgemm(
'N',
'C', m2, m1, n-m1, one, a( i1, i1 ), lda,
189 & a( 1, i1 ), lda, one, t( i1, 1 ), ldt)
191 CALL ctrmm(
'R',
'U',
'N',
'N', m2, m1, one,
192 & t, ldt, t( i1, 1 ), ldt )
194 CALL cgemm(
'N',
'N', m2, n-m1, m1, -one, t( i1, 1 ), ldt,
195 & a( 1, i1 ), lda, one, a( i1, i1 ), lda )
197 CALL ctrmm(
'R',
'U',
'N',
'U', m2, m1 , one,
198 & a, lda, t( i1, 1 ), ldt )
202 a( i+m1, j ) = a( i+m1, j ) - t( i+m1, j )
209 CALL cgelqt3( m2, n-m1, a( i1, i1 ), lda,
210 & t( i1, i1 ), ldt, iinfo )
216 t( j, i+m1 ) = (a( j, i+m1 ))
220 CALL ctrmm(
'R',
'U',
'C',
'U', m1, m2, one,
221 & a( i1, i1 ), lda, t( 1, i1 ), ldt )
223 CALL cgemm(
'N',
'C', m1, m2, n-m, one, a( 1, j1 ), lda,
224 & a( i1, j1 ), lda, one, t( 1, i1 ), ldt )
226 CALL ctrmm(
'L',
'U',
'N',
'N', m1, m2, -one, t, ldt,
229 CALL ctrmm(
'R',
'U',
'N',
'N', m1, m2, one,
230 & t( i1, i1 ), ldt, t( 1, i1 ), ldt )
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM
subroutine ctrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
CTRMM
subroutine clarfg(N, ALPHA, X, INCX, TAU)
CLARFG generates an elementary reflector (Householder matrix).
recursive subroutine cgelqt3(M, N, A, LDA, T, LDT, INFO)
CGELQT3