103 SUBROUTINE slauum( UPLO, N, A, LDA, INFO )
122 parameter ( one = 1.0e+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(
'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 )
subroutine ssyrk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
SSYRK
subroutine sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM
subroutine xerbla(SRNAME, INFO)
XERBLA
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
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...