143 SUBROUTINE dpbtrf( UPLO, N, KD, AB, LDAB, INFO )
152 INTEGER info, kd, ldab, n
155 DOUBLE PRECISION ab( ldab, * )
161 DOUBLE PRECISION one, zero
162 parameter( one = 1.0d+0, zero = 0.0d+0 )
163 INTEGER nbmax, ldwork
164 parameter( nbmax = 32, ldwork = nbmax+1 )
167 INTEGER i, i2, i3, ib, ii,
j, jj, nb
170 DOUBLE PRECISION work( ldwork, nbmax )
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(
'DPBTRF', -info )
210 nb =
ilaenv( 1,
'DPBTRF', uplo, n, kd, -1, -1 )
215 nb = min( nb, nbmax )
217 IF( nb.LE.1 .OR. nb.GT.kd )
THEN
221 CALL
dpbtf2( uplo, n, kd, ab, ldab, info )
226 IF(
lsame( uplo,
'U' ) )
THEN
243 ib = min( nb, n-i+1 )
247 CALL
dpotf2( 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
dtrsm(
'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
dsyrk(
'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
dtrsm(
'Left',
'Upper',
'Transpose',
299 $
'Non-unit', ib, i3, one, ab( kd+1, i ),
300 $ ldab-1, work, ldwork )
305 $ CALL
dgemm(
'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
dsyrk(
'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
dpotf2( 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
dtrsm(
'Right',
'Lower',
'Transpose',
376 $
'Non-unit', i2, ib, one, ab( 1, i ),
377 $ ldab-1, ab( 1+ib, i ), ldab-1 )
381 CALL
dsyrk(
'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
dtrsm(
'Right',
'Lower',
'Transpose',
399 $
'Non-unit', i3, ib, one, ab( 1, i ),
400 $ ldab-1, work, ldwork )
405 $ CALL
dgemm(
'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
dsyrk(
'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 dpotf2(UPLO, N, A, LDA, INFO)
DPOTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite matrix (unblock...
subroutine dpbtf2(UPLO, N, KD, AB, LDAB, INFO)
DPBTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite band matrix (un...
subroutine dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
DGEMM
subroutine xerbla(SRNAME, INFO)
XERBLA
logical function lsame(CA, CB)
LSAME
subroutine dpbtrf(UPLO, N, KD, AB, LDAB, INFO)
DPBTRF
subroutine dtrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
DTRSM
subroutine dsyrk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
DSYRK
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)