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 )
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 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 zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
subroutine zpbtrf(UPLO, N, KD, AB, LDAB, INFO)
ZPBTRF
subroutine xerbla(SRNAME, INFO)
XERBLA
logical function lsame(CA, CB)
LSAME
subroutine zpbtf2(UPLO, N, KD, AB, LDAB, INFO)
ZPBTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite band matrix (un...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine zpotf2(UPLO, N, A, LDA, INFO)
ZPOTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite matrix (unblock...
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)