101 SUBROUTINE clauum( UPLO, N, A, LDA, INFO )
119 parameter( one = 1.0e+0 )
121 parameter( cone = ( 1.0e+0, 0.0e+0 ) )
130 EXTERNAL lsame, ilaenv
143 upper = lsame( uplo,
'U' )
144 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
146 ELSE IF( n.LT.0 )
THEN
148 ELSE IF( lda.LT.max( 1, n ) )
THEN
152 CALL xerbla(
'CLAUUM', -info )
163 nb = ilaenv( 1,
'CLAUUM', uplo, n, -1, -1, -1 )
165 IF( nb.LE.1 .OR. nb.GE.n )
THEN
169 CALL clauu2( uplo, n, a, lda, info )
179 ib = min( nb, n-i+1 )
180 CALL ctrmm(
'Right',
'Upper',
'Conjugate transpose',
181 $
'Non-unit', i-1, ib, cone, a( i, i ), lda,
183 CALL clauu2(
'Upper', ib, a( i, i ), lda, info )
185 CALL cgemm(
'No transpose',
'Conjugate transpose',
186 $ i-1, ib, n-i-ib+1, cone, a( 1, i+ib ),
187 $ lda, a( i, i+ib ), lda, cone, a( 1, i ),
189 CALL cherk(
'Upper',
'No transpose', ib, n-i-ib+1,
190 $ one, a( i, i+ib ), lda, one, a( i, i ),
199 ib = min( nb, n-i+1 )
200 CALL ctrmm(
'Left',
'Lower',
'Conjugate transpose',
201 $
'Non-unit', ib, i-1, cone, a( i, i ), lda,
203 CALL clauu2(
'Lower', ib, a( i, i ), lda, info )
205 CALL cgemm(
'Conjugate transpose',
'No transpose', ib,
206 $ i-1, n-i-ib+1, cone, a( i+ib, i ), lda,
207 $ a( i+ib, 1 ), lda, cone, a( i, 1 ), lda )
208 CALL cherk(
'Lower',
'Conjugate transpose', ib,
209 $ n-i-ib+1, one, a( i+ib, i ), lda, one,
subroutine xerbla(srname, info)
subroutine cgemm(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
CGEMM
subroutine cherk(uplo, trans, n, k, alpha, a, lda, beta, c, ldc)
CHERK
subroutine clauu2(uplo, n, a, lda, info)
CLAUU2 computes the product UUH or LHL, where U and L are upper or lower triangular matrices (unblock...
subroutine clauum(uplo, n, a, lda, info)
CLAUUM computes the product UUH or LHL, where U and L are upper or lower triangular matrices (blocked...
subroutine ctrmm(side, uplo, transa, diag, m, n, alpha, a, lda, b, ldb)
CTRMM