143 SUBROUTINE spbtrf( UPLO, N, KD, AB, LDAB, INFO )
152 INTEGER INFO, KD, LDAB, N
162 parameter ( one = 1.0e+0, zero = 0.0e+0 )
163 INTEGER NBMAX, LDWORK
164 parameter ( nbmax = 32, ldwork = nbmax+1 )
167 INTEGER I, I2, I3, IB, II, J, JJ, NB
170 REAL WORK( ldwork, nbmax )
175 EXTERNAL lsame, ilaenv
188 IF( ( .NOT.lsame( uplo,
'U' ) ) .AND.
189 $ ( .NOT.lsame( uplo,
'L' ) ) )
THEN
191 ELSE IF( n.LT.0 )
THEN
193 ELSE IF( kd.LT.0 )
THEN
195 ELSE IF( ldab.LT.kd+1 )
THEN
199 CALL xerbla(
'SPBTRF', -info )
210 nb = ilaenv( 1,
'SPBTRF', uplo, n, kd, -1, -1 )
215 nb = min( nb, nbmax )
217 IF( nb.LE.1 .OR. nb.GT.kd )
THEN
221 CALL spbtf2( uplo, n, kd, ab, ldab, info )
226 IF( lsame( uplo,
'U' ) )
THEN
243 ib = min( nb, n-i+1 )
247 CALL spotf2( uplo, ib, ab( kd+1, i ), ldab-1, ii )
268 i2 = min( kd-ib, n-i-ib+1 )
269 i3 = min( ib, n-i-kd+1 )
275 CALL strsm(
'Left',
'Upper',
'Transpose',
276 $
'Non-unit', ib, i2, one, ab( kd+1, i ),
277 $ ldab-1, ab( kd+1-ib, i+ib ), ldab-1 )
281 CALL ssyrk(
'Upper',
'Transpose', i2, ib, -one,
282 $ ab( kd+1-ib, i+ib ), ldab-1, one,
283 $ ab( kd+1, i+ib ), ldab-1 )
292 work( ii, jj ) = ab( ii-jj+1, jj+i+kd-1 )
298 CALL strsm(
'Left',
'Upper',
'Transpose',
299 $
'Non-unit', ib, i3, one, ab( kd+1, i ),
300 $ ldab-1, work, ldwork )
305 $
CALL sgemm(
'Transpose',
'No Transpose', i2, i3,
306 $ ib, -one, ab( kd+1-ib, i+ib ),
307 $ ldab-1, work, ldwork, one,
308 $ ab( 1+ib, i+kd ), ldab-1 )
312 CALL ssyrk(
'Upper',
'Transpose', i3, ib, -one,
313 $ work, ldwork, one, ab( kd+1, i+kd ),
320 ab( ii-jj+1, jj+i+kd-1 ) = work( ii, jj )
343 ib = min( nb, n-i+1 )
347 CALL spotf2( uplo, ib, ab( 1, i ), ldab-1, ii )
368 i2 = min( kd-ib, n-i-ib+1 )
369 i3 = min( ib, n-i-kd+1 )
375 CALL strsm(
'Right',
'Lower',
'Transpose',
376 $
'Non-unit', i2, ib, one, ab( 1, i ),
377 $ ldab-1, ab( 1+ib, i ), ldab-1 )
381 CALL ssyrk(
'Lower',
'No Transpose', i2, ib, -one,
382 $ ab( 1+ib, i ), ldab-1, one,
383 $ ab( 1, i+ib ), ldab-1 )
391 DO 100 ii = 1, min( jj, i3 )
392 work( ii, jj ) = ab( kd+1-jj+ii, jj+i-1 )
398 CALL strsm(
'Right',
'Lower',
'Transpose',
399 $
'Non-unit', i3, ib, one, ab( 1, i ),
400 $ ldab-1, work, ldwork )
405 $
CALL sgemm(
'No transpose',
'Transpose', i3, i2,
406 $ ib, -one, work, ldwork,
407 $ ab( 1+ib, i ), ldab-1, one,
408 $ ab( 1+kd-ib, i+ib ), ldab-1 )
412 CALL ssyrk(
'Lower',
'No Transpose', i3, ib, -one,
413 $ work, ldwork, one, ab( 1, i+kd ),
419 DO 120 ii = 1, min( jj, i3 )
420 ab( kd+1-jj+ii, jj+i-1 ) = work( ii, jj )
subroutine ssyrk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
SSYRK
subroutine strsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
STRSM
subroutine sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM
subroutine spotf2(UPLO, N, A, LDA, INFO)
SPOTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite matrix (unblock...
subroutine spbtf2(UPLO, N, KD, AB, LDAB, INFO)
SPBTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite band matrix (un...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine spbtrf(UPLO, N, KD, AB, LDAB, INFO)
SPBTRF