103 SUBROUTINE dlauum( UPLO, N, A, LDA, INFO )
115 DOUBLE PRECISION a( lda, * )
122 parameter( one = 1.0d+0 )
144 upper =
lsame( uplo,
'U' )
145 IF( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
147 ELSE IF( n.LT.0 )
THEN
149 ELSE IF( lda.LT.max( 1, n ) )
THEN
153 CALL
xerbla(
'DLAUUM', -info )
164 nb =
ilaenv( 1,
'DLAUUM', uplo, n, -1, -1, -1 )
166 IF( nb.LE.1 .OR. nb.GE.n )
THEN
170 CALL
dlauu2( uplo, n, a, lda, info )
180 ib = min( nb, n-i+1 )
181 CALL
dtrmm(
'Right',
'Upper',
'Transpose',
'Non-unit',
182 $ i-1, ib, one, a( i, i ), lda, a( 1, i ),
184 CALL
dlauu2(
'Upper', ib, a( i, i ), lda, info )
186 CALL
dgemm(
'No transpose',
'Transpose', i-1, ib,
187 $ n-i-ib+1, one, a( 1, i+ib ), lda,
188 $ a( i, i+ib ), lda, one, a( 1, i ), lda )
189 CALL
dsyrk(
'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
dtrmm(
'Left',
'Lower',
'Transpose',
'Non-unit', ib,
201 $ i-1, one, a( i, i ), lda, a( i, 1 ), lda )
202 CALL
dlauu2(
'Lower', ib, a( i, i ), lda, info )
204 CALL
dgemm(
'Transpose',
'No transpose', ib, i-1,
205 $ n-i-ib+1, one, a( i+ib, i ), lda,
206 $ a( i+ib, 1 ), lda, one, a( i, 1 ), lda )
207 CALL
dsyrk(
'Lower',
'Transpose', ib, n-i-ib+1, one,
208 $ a( i+ib, i ), lda, one, a( i, i ), lda )
LOGICAL function lsame(CA, CB)
LSAME
subroutine dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
DGEMM
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dlauu2(UPLO, N, A, LDA, INFO)
DLAUU2 computes the product UUH or LHL, where U and L are upper or lower triangular matrices (unblock...
subroutine dsyrk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
DSYRK
INTEGER function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
subroutine dlauum(UPLO, N, A, LDA, INFO)
DLAUUM computes the product UUH or LHL, where U and L are upper or lower triangular matrices (blocked...
subroutine dtrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
DTRMM