103 SUBROUTINE dlauum( UPLO, N, A, LDA, INFO )
115 DOUBLE PRECISION A( lda, * )
122 parameter ( one = 1.0d+0 )
131 EXTERNAL lsame, ilaenv
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 )
subroutine dtrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
DTRMM
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 dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
DGEMM
subroutine dsyrk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
DSYRK
subroutine xerbla(SRNAME, INFO)
XERBLA
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...