1 SUBROUTINE clauum( UPLO, N, A, LDA, INFO )
60 parameter( one = 1.0e+0 )
62 parameter( cone = ( 1.0e+0, 0.0e+0 ) )
71 EXTERNAL lsame, ilaenv
84 upper = lsame(
uplo,
'U' )
85 IF( .NOT.upper .AND. .NOT.lsame(
uplo,
'L' ) )
THEN
87 ELSE IF( n.LT.0 )
THEN
89 ELSE IF( lda.LT.
max( 1, n ) )
THEN
93 CALL
xerbla(
'CLAUUM', -info )
104 nb = ilaenv( 1,
'CLAUUM',
uplo, n, -1, -1, -1 )
106 IF( nb.LE.1 .OR. nb.GE.n )
THEN
120 ib =
min( nb, n-i+1 )
121 CALL ctrmm(
'Right',
'Upper',
'Conjugate transpose',
122 $
'Non-unit', i-1, ib, cone, a( i, i ), lda,
124 CALL
clauu2(
'Upper', ib, a( i, i ), lda, info )
126 CALL cgemm(
'No transpose',
'Conjugate transpose',
127 $ i-1, ib, n-i-ib+1, cone, a( 1, i+ib ),
128 $ lda, a( i, i+ib ), lda, cone, a( 1, i ),
130 CALL cherk(
'Upper',
'No transpose', ib, n-i-ib+1,
131 $ one, a( i, i+ib ), lda, one, a( i, i ),
140 ib =
min( nb, n-i+1 )
141 CALL ctrmm(
'Left',
'Lower',
'Conjugate transpose',
142 $
'Non-unit', ib, i-1, cone, a( i, i ), lda,
144 CALL
clauu2(
'Lower', ib, a( i, i ), lda, info )
146 CALL cgemm(
'Conjugate transpose',
'No transpose', ib,
147 $ i-1, n-i-ib+1, cone, a( i+ib, i ), lda,
148 $ a( i+ib, 1 ), lda, cone, a( i, 1 ), lda )
149 CALL cherk(
'Lower',
'Conjugate transpose', ib,
150 $ n-i-ib+1, one, a( i+ib, i ), lda, one,