143 SUBROUTINE cpbtrf( UPLO, N, KD, AB, LDAB, INFO )
152 INTEGER INFO, KD, LDAB, N
155 COMPLEX AB( ldab, * )
162 parameter( one = 1.0e+0, zero = 0.0e+0 )
164 parameter( cone = ( 1.0e+0, 0.0e+0 ) )
165 INTEGER NBMAX, LDWORK
166 parameter( nbmax = 32, ldwork = nbmax+1 )
169 INTEGER I, I2, I3, IB, II, J, JJ, NB
172 COMPLEX WORK( ldwork, nbmax )
177 EXTERNAL lsame, ilaenv
190 IF( ( .NOT.lsame( uplo,
'U' ) ) .AND.
191 $ ( .NOT.lsame( uplo,
'L' ) ) )
THEN
193 ELSE IF( n.LT.0 )
THEN
195 ELSE IF( kd.LT.0 )
THEN
197 ELSE IF( ldab.LT.kd+1 )
THEN
201 CALL
xerbla(
'CPBTRF', -info )
212 nb = ilaenv( 1,
'CPBTRF', uplo, n, kd, -1, -1 )
217 nb = min( nb, nbmax )
219 IF( nb.LE.1 .OR. nb.GT.kd )
THEN
223 CALL
cpbtf2( uplo, n, kd, ab, ldab, info )
228 IF( lsame( uplo,
'U' ) )
THEN
245 ib = min( nb, n-i+1 )
249 CALL
cpotf2( uplo, ib, ab( kd+1, i ), ldab-1, ii )
270 i2 = min( kd-ib, n-i-ib+1 )
271 i3 = min( ib, n-i-kd+1 )
277 CALL
ctrsm(
'Left',
'Upper',
'Conjugate transpose',
278 $
'Non-unit', ib, i2, cone,
279 $ ab( kd+1, i ), ldab-1,
280 $ ab( kd+1-ib, i+ib ), ldab-1 )
284 CALL
cherk(
'Upper',
'Conjugate transpose', i2, ib,
285 $ -one, ab( kd+1-ib, i+ib ), ldab-1, one,
286 $ ab( kd+1, i+ib ), ldab-1 )
295 work( ii, jj ) = ab( ii-jj+1, jj+i+kd-1 )
301 CALL
ctrsm(
'Left',
'Upper',
'Conjugate transpose',
302 $
'Non-unit', ib, i3, cone,
303 $ ab( kd+1, i ), ldab-1, work, ldwork )
308 $ CALL
cgemm(
'Conjugate transpose',
309 $
'No transpose', i2, i3, ib, -cone,
310 $ ab( kd+1-ib, i+ib ), ldab-1, work,
311 $ ldwork, cone, ab( 1+ib, i+kd ),
316 CALL
cherk(
'Upper',
'Conjugate transpose', i3, ib,
317 $ -one, work, ldwork, one,
318 $ ab( kd+1, i+kd ), ldab-1 )
324 ab( ii-jj+1, jj+i+kd-1 ) = work( ii, jj )
347 ib = min( nb, n-i+1 )
351 CALL
cpotf2( uplo, ib, ab( 1, i ), ldab-1, ii )
372 i2 = min( kd-ib, n-i-ib+1 )
373 i3 = min( ib, n-i-kd+1 )
379 CALL
ctrsm(
'Right',
'Lower',
380 $
'Conjugate transpose',
'Non-unit', i2,
381 $ ib, cone, ab( 1, i ), ldab-1,
382 $ ab( 1+ib, i ), ldab-1 )
386 CALL
cherk(
'Lower',
'No transpose', i2, ib, -one,
387 $ ab( 1+ib, i ), ldab-1, one,
388 $ ab( 1, i+ib ), ldab-1 )
396 DO 100 ii = 1, min( jj, i3 )
397 work( ii, jj ) = ab( kd+1-jj+ii, jj+i-1 )
403 CALL
ctrsm(
'Right',
'Lower',
404 $
'Conjugate transpose',
'Non-unit', i3,
405 $ ib, cone, ab( 1, i ), ldab-1, work,
411 $ CALL
cgemm(
'No transpose',
412 $
'Conjugate transpose', i3, i2, ib,
413 $ -cone, work, ldwork, ab( 1+ib, i ),
414 $ ldab-1, cone, ab( 1+kd-ib, i+ib ),
419 CALL
cherk(
'Lower',
'No transpose', i3, ib, -one,
420 $ work, ldwork, one, ab( 1, i+kd ),
426 DO 120 ii = 1, min( jj, i3 )
427 ab( kd+1-jj+ii, jj+i-1 ) = work( ii, jj )
subroutine ctrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
CTRSM
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cpbtrf(UPLO, N, KD, AB, LDAB, INFO)
CPBTRF
subroutine cpotf2(UPLO, N, A, LDA, INFO)
CPOTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite matrix (unblock...
subroutine cpbtf2(UPLO, N, KD, AB, LDAB, INFO)
CPBTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite band matrix (un...
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM
subroutine cherk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
CHERK