103 SUBROUTINE slauum( UPLO, N, A, LDA, INFO )
122 parameter( one = 1.0e+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(
'SLAUUM', -info )
164 nb =
ilaenv( 1,
'SLAUUM', uplo, n, -1, -1, -1 )
166 IF( nb.LE.1 .OR. nb.GE.n )
THEN
170 CALL
slauu2( uplo, n, a, lda, info )
180 ib = min( nb, n-i+1 )
181 CALL
strmm(
'Right',
'Upper',
'Transpose',
'Non-unit',
182 $ i-1, ib, one, a( i, i ), lda, a( 1, i ),
184 CALL
slauu2(
'Upper', ib, a( i, i ), lda, info )
186 CALL
sgemm(
'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
ssyrk(
'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
strmm(
'Left',
'Lower',
'Transpose',
'Non-unit', ib,
201 $ i-1, one, a( i, i ), lda, a( i, 1 ), lda )
202 CALL
slauu2(
'Lower', ib, a( i, i ), lda, info )
204 CALL
sgemm(
'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
ssyrk(
'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 ssyrk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
SSYRK
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine slauum(UPLO, N, A, LDA, INFO)
SLAUUM computes the product UUH or LHL, where U and L are upper or lower triangular matrices (blocked...
subroutine slauu2(UPLO, N, A, LDA, INFO)
SLAUU2 computes the product UUH or LHL, where U and L are upper or lower triangular matrices (unblock...
subroutine strmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
STRMM
INTEGER function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
subroutine sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM