139 SUBROUTINE cpbtrf( UPLO, N, KD, AB, LDAB, INFO )
147 INTEGER INFO, KD, LDAB, N
150 COMPLEX AB( LDAB, * )
157 parameter( one = 1.0e+0, zero = 0.0e+0 )
159 parameter( cone = ( 1.0e+0, 0.0e+0 ) )
160 INTEGER NBMAX, LDWORK
161 parameter( nbmax = 32, ldwork = nbmax+1 )
164 INTEGER I, I2, I3, IB, II, J, JJ, NB
167 COMPLEX WORK( LDWORK, NBMAX )
172 EXTERNAL lsame, ilaenv
186 IF( ( .NOT.lsame( uplo,
'U' ) ) .AND.
187 $ ( .NOT.lsame( uplo,
'L' ) ) )
THEN
189 ELSE IF( n.LT.0 )
THEN
191 ELSE IF( kd.LT.0 )
THEN
193 ELSE IF( ldab.LT.kd+1 )
THEN
197 CALL xerbla(
'CPBTRF', -info )
208 nb = ilaenv( 1,
'CPBTRF', uplo, n, kd, -1, -1 )
213 nb = min( nb, nbmax )
215 IF( nb.LE.1 .OR. nb.GT.kd )
THEN
219 CALL cpbtf2( uplo, n, kd, ab, ldab, info )
224 IF( lsame( uplo,
'U' ) )
THEN
241 ib = min( nb, n-i+1 )
245 CALL cpotf2( uplo, ib, ab( kd+1, i ), ldab-1, ii )
266 i2 = min( kd-ib, n-i-ib+1 )
267 i3 = min( ib, n-i-kd+1 )
273 CALL ctrsm(
'Left',
'Upper',
274 $
'Conjugate transpose',
275 $
'Non-unit', ib, i2, cone,
276 $ ab( kd+1, i ), ldab-1,
277 $ ab( kd+1-ib, i+ib ), ldab-1 )
281 CALL cherk(
'Upper',
'Conjugate transpose', i2,
283 $ -one, ab( kd+1-ib, i+ib ), ldab-1, one,
284 $ ab( kd+1, i+ib ), ldab-1 )
293 work( ii, jj ) = ab( ii-jj+1, jj+i+kd-1 )
299 CALL ctrsm(
'Left',
'Upper',
300 $
'Conjugate transpose',
301 $
'Non-unit', ib, i3, cone,
302 $ ab( kd+1, i ), ldab-1, work, ldwork )
307 $
CALL cgemm(
'Conjugate transpose',
308 $
'No transpose', i2, i3, ib, -cone,
309 $ ab( kd+1-ib, i+ib ), ldab-1, work,
310 $ ldwork, cone, ab( 1+ib, i+kd ),
315 CALL cherk(
'Upper',
'Conjugate transpose', i3,
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,
388 $ ab( 1+ib, i ), ldab-1, one,
389 $ ab( 1, i+ib ), ldab-1 )
397 DO 100 ii = 1, min( jj, i3 )
398 work( ii, jj ) = ab( kd+1-jj+ii, jj+i-1 )
404 CALL ctrsm(
'Right',
'Lower',
405 $
'Conjugate transpose',
'Non-unit', i3,
406 $ ib, cone, ab( 1, i ), ldab-1, work,
412 $
CALL cgemm(
'No transpose',
413 $
'Conjugate transpose', i3, i2, ib,
414 $ -cone, work, ldwork, ab( 1+ib, i ),
415 $ ldab-1, cone, ab( 1+kd-ib, i+ib ),
420 CALL cherk(
'Lower',
'No transpose', i3, ib,
422 $ work, ldwork, one, ab( 1, i+kd ),
428 DO 120 ii = 1, min( jj, i3 )
429 ab( kd+1-jj+ii, jj+i-1 ) = work( ii, jj )