1 SUBROUTINE dpbtrf( UPLO, N, KD, AB, LDAB, INFO )
10 INTEGER INFO, KD, LDAB, N
13 DOUBLE PRECISION AB( LDAB, * )
91 DOUBLE PRECISION ONE, ZERO
92 parameter( one = 1.0d+0, zero = 0.0d+0 )
94 parameter( nbmax = 32, ldwork = nbmax+1 )
97 INTEGER I, I2, I3, IB, II, J, JJ, NB
100 DOUBLE PRECISION WORK( LDWORK, NBMAX )
105 EXTERNAL lsame, ilaenv
118 IF( ( .NOT.lsame( uplo,
'U' ) ) .AND.
119 $ ( .NOT.lsame( uplo,
'L' ) ) )
THEN
121 ELSE IF( n.LT.0 )
THEN
123 ELSE IF( kd.LT.0 )
THEN
125 ELSE IF( ldab.LT.kd+1 )
THEN
129 CALL xerbla(
'DPBTRF', -info )
140 nb = ilaenv( 1,
'DPBTRF', uplo, n, kd, -1, -1 )
145 nb = min( nb, nbmax )
147 IF( nb.LE.1 .OR. nb.GT.kd )
THEN
151 CALL dpbtf2( uplo, n, kd, ab, ldab, info )
156 IF( lsame( uplo,
'U' ) )
THEN
173 ib = min( nb, n-i+1 )
177 CALL dpotf2( uplo, ib, ab( kd+1, i ), ldab-1, ii )
198 i2 = min( kd-ib, n-i-ib+1 )
199 i3 = min( ib, n-i-kd+1 )
205 CALL dtrsm(
'Left',
'Upper',
'Transpose',
206 $
'Non-unit', ib, i2, one, ab( kd+1, i ),
207 $ ldab-1, ab( kd+1-ib, i+ib ), ldab-1 )
211 CALL dsyrk(
'Upper',
'Transpose', i2, ib, -one,
212 $ ab( kd+1-ib, i+ib ), ldab-1, one,
213 $ ab( kd+1, i+ib ), ldab-1 )
222 work( ii, jj ) = ab( ii-jj+1, jj+i+kd-1 )
228 CALL dtrsm(
'Left',
'Upper',
'Transpose',
229 $
'Non-unit', ib, i3, one, ab( kd+1, i ),
230 $ ldab-1, work, ldwork )
235 $
CALL dgemm(
'Transpose',
'No Transpose', i2, i3,
236 $ ib, -one, ab( kd+1-ib, i+ib ),
237 $ ldab-1, work, ldwork, one,
238 $ ab( 1+ib, i+kd ), ldab-1 )
242 CALL dsyrk(
'Upper',
'Transpose', i3, ib, -one,
243 $ work, ldwork, one, ab( kd+1, i+kd ),
250 ab( ii-jj+1, jj+i+kd-1 ) = work( ii, jj )
273 ib = min( nb, n-i+1 )
277 CALL dpotf2( uplo, ib, ab( 1, i ), ldab-1, ii )
298 i2 = min( kd-ib, n-i-ib+1 )
299 i3 = min( ib, n-i-kd+1 )
305 CALL dtrsm(
'Right',
'Lower',
'Transpose',
306 $
'Non-unit', i2, ib, one, ab( 1, i ),
307 $ ldab-1, ab( 1+ib, i ), ldab-1 )
311 CALL dsyrk(
'Lower',
'No Transpose', i2, ib, -one,
312 $ ab( 1+ib, i ), ldab-1, one,
313 $ ab( 1, i+ib ), ldab-1 )
321 DO 100 ii = 1, min( jj, i3 )
322 work( ii, jj ) = ab( kd+1-jj+ii, jj+i-1 )
328 CALL dtrsm(
'Right',
'Lower',
'Transpose',
329 $
'Non-unit', i3, ib, one, ab( 1, i ),
330 $ ldab-1, work, ldwork )
335 $
CALL dgemm(
'No transpose',
'Transpose', i3, i2,
336 $ ib, -one, work, ldwork,
337 $ ab( 1+ib, i ), ldab-1, one,
338 $ ab( 1+kd-ib, i+ib ), ldab-1 )
342 CALL dsyrk(
'Lower',
'No Transpose', i3, ib, -one,
343 $ work, ldwork, one, ab( 1, i+kd ),
349 DO 120 ii = 1, min( jj, i3 )
350 ab( kd+1-jj+ii, jj+i-1 ) = work( ii, jj )
subroutine dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
subroutine dpbtf2(UPLO, N, KD, AB, LDAB, INFO)
subroutine dpbtrf(UPLO, N, KD, AB, LDAB, INFO)
subroutine dpotf2(UPLO, N, A, LDA, INFO)
subroutine dsyrk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
subroutine dtrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
subroutine xerbla(SRNAME, INFO)