103 SUBROUTINE clauum( UPLO, N, A, LDA, INFO )
122 parameter( one = 1.0e+0 )
124 parameter( cone = ( 1.0e+0, 0.0e+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(
'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 xerbla(SRNAME, INFO)
XERBLA
subroutine ctrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
CTRMM
logical function lsame(CA, CB)
LSAME
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...
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
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