103 SUBROUTINE zlauum( UPLO, N, A, LDA, INFO )
115 COMPLEX*16 a( lda, * )
122 parameter( one = 1.0d+0 )
124 parameter( cone = ( 1.0d+0, 0.0d+0 ) )
146 upper =
lsame( uplo,
'U' )
147 IF( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
149 ELSE IF( n.LT.0 )
THEN
151 ELSE IF( lda.LT.max( 1, n ) )
THEN
155 CALL
xerbla(
'ZLAUUM', -info )
166 nb =
ilaenv( 1,
'ZLAUUM', uplo, n, -1, -1, -1 )
168 IF( nb.LE.1 .OR. nb.GE.n )
THEN
172 CALL
zlauu2( uplo, n, a, lda, info )
182 ib = min( nb, n-i+1 )
183 CALL
ztrmm(
'Right',
'Upper',
'Conjugate transpose',
184 $
'Non-unit', i-1, ib, cone, a( i, i ), lda,
186 CALL
zlauu2(
'Upper', ib, a( i, i ), lda, info )
188 CALL
zgemm(
'No transpose',
'Conjugate transpose',
189 $ i-1, ib, n-i-ib+1, cone, a( 1, i+ib ),
190 $ lda, a( i, i+ib ), lda, cone, a( 1, i ),
192 CALL
zherk(
'Upper',
'No transpose', ib, n-i-ib+1,
193 $ one, a( i, i+ib ), lda, one, a( i, i ),
202 ib = min( nb, n-i+1 )
203 CALL
ztrmm(
'Left',
'Lower',
'Conjugate transpose',
204 $
'Non-unit', ib, i-1, cone, a( i, i ), lda,
206 CALL
zlauu2(
'Lower', ib, a( i, i ), lda, info )
208 CALL
zgemm(
'Conjugate transpose',
'No transpose', ib,
209 $ i-1, n-i-ib+1, cone, a( i+ib, i ), lda,
210 $ a( i+ib, 1 ), lda, cone, a( i, 1 ), lda )
211 CALL
zherk(
'Lower',
'Conjugate transpose', ib,
212 $ n-i-ib+1, one, a( i+ib, i ), lda, one,
subroutine zherk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
ZHERK
subroutine zlauu2(UPLO, N, A, LDA, INFO)
ZLAUU2 computes the product UUH or LHL, where U and L are upper or lower triangular matrices (unblock...
subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
subroutine xerbla(SRNAME, INFO)
XERBLA
logical function lsame(CA, CB)
LSAME
subroutine zlauum(UPLO, N, A, LDA, INFO)
ZLAUUM computes the product UUH or LHL, where U and L are upper or lower triangular matrices (blocked...
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
subroutine ztrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
ZTRMM