143 SUBROUTINE zpbtrf( UPLO, N, KD, AB, LDAB, INFO )
152 INTEGER INFO, KD, LDAB, N
155 COMPLEX*16 AB( ldab, * )
161 DOUBLE PRECISION ONE, ZERO
162 parameter ( one = 1.0d+0, zero = 0.0d+0 )
164 parameter ( cone = ( 1.0d+0, 0.0d+0 ) )
165 INTEGER NBMAX, LDWORK
166 parameter ( nbmax = 32, ldwork = nbmax+1 )
169 INTEGER I, I2, I3, IB, II, J, JJ, NB
172 COMPLEX*16 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(
'ZPBTRF', -info )
212 nb = ilaenv( 1,
'ZPBTRF', uplo, n, kd, -1, -1 )
217 nb = min( nb, nbmax )
219 IF( nb.LE.1 .OR. nb.GT.kd )
THEN
223 CALL zpbtf2( uplo, n, kd, ab, ldab, info )
228 IF( lsame( uplo,
'U' ) )
THEN
245 ib = min( nb, n-i+1 )
249 CALL zpotf2( 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 ztrsm(
'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 zherk(
'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 ztrsm(
'Left',
'Upper',
'Conjugate transpose',
302 $
'Non-unit', ib, i3, cone,
303 $ ab( kd+1, i ), ldab-1, work, ldwork )
308 $
CALL zgemm(
'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 zherk(
'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 zpotf2( 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 ztrsm(
'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 zherk(
'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 ztrsm(
'Right',
'Lower',
404 $
'Conjugate transpose',
'Non-unit', i3,
405 $ ib, cone, ab( 1, i ), ldab-1, work,
411 $
CALL zgemm(
'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 zherk(
'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 zpbtrf(UPLO, N, KD, AB, LDAB, INFO)
ZPBTRF
subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
subroutine zpbtf2(UPLO, N, KD, AB, LDAB, INFO)
ZPBTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite band matrix (un...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zherk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
ZHERK
subroutine ztrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
ZTRSM
subroutine zpotf2(UPLO, N, A, LDA, INFO)
ZPOTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite matrix (unblock...