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 )