103 SUBROUTINE clauum( UPLO, N, A, LDA, INFO )
122 parameter ( one = 1.0e+0 )
124 parameter ( cone = ( 1.0e+0, 0.0e+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(
'CLAUUM', -info )
166 nb = ilaenv( 1,
'CLAUUM', uplo, n, -1, -1, -1 )
168 IF( nb.LE.1 .OR. nb.GE.n )
THEN
172 CALL clauu2( uplo, n, a, lda, info )
182 ib = min( nb, n-i+1 )
183 CALL ctrmm(
'Right',
'Upper',
'Conjugate transpose',
184 $
'Non-unit', i-1, ib, cone, a( i, i ), lda,
186 CALL clauu2(
'Upper', ib, a( i, i ), lda, info )
188 CALL cgemm(
'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 cherk(
'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 ctrmm(
'Left',
'Lower',
'Conjugate transpose',
204 $
'Non-unit', ib, i-1, cone, a( i, i ), lda,
206 CALL clauu2(
'Lower', ib, a( i, i ), lda, info )
208 CALL cgemm(
'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 cherk(
'Lower',
'Conjugate transpose', ib,
212 $ n-i-ib+1, one, a( i+ib, i ), lda, one,
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 cherk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
CHERK
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine ctrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
CTRMM
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM
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...