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 ) )
133 EXTERNAL lsame, ilaenv
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 zlauum(UPLO, N, A, LDA, INFO)
ZLAUUM computes the product UUH or LHL, where U and L are upper or lower triangular matrices (blocked...
subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine ztrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
ZTRMM
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...