150 SUBROUTINE zpbstf( UPLO, N, KD, AB, LDAB, INFO )
158 INTEGER INFO, KD, LDAB, N
161 COMPLEX*16 AB( LDAB, * )
167 DOUBLE PRECISION ONE, ZERO
168 parameter( one = 1.0d+0, zero = 0.0d+0 )
172 INTEGER J, KLD, KM, M
183 INTRINSIC dble, max, min, sqrt
190 upper = lsame( uplo,
'U' )
191 IF( .NOT.upper .AND. .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(
'ZPBSTF', -info )
210 kld = max( 1, ldab-1 )
220 DO 10 j = n, m + 1, -1
224 ajj = dble( ab( kd+1, j ) )
225 IF( ajj.LE.zero )
THEN
236 CALL zdscal( km, one / ajj, ab( kd+1-km, j ), 1 )
237 CALL zher(
'Upper', km, -one, ab( kd+1-km, j ), 1,
238 $ ab( kd+1, j-km ), kld )
247 ajj = dble( ab( kd+1, j ) )
248 IF( ajj.LE.zero )
THEN
260 CALL zdscal( km, one / ajj, ab( kd, j+1 ), kld )
261 CALL zlacgv( km, ab( kd, j+1 ), kld )
262 CALL zher(
'Upper', km, -one, ab( kd, j+1 ), kld,
263 $ ab( kd+1, j+1 ), kld )
264 CALL zlacgv( km, ab( kd, j+1 ), kld )
271 DO 30 j = n, m + 1, -1
275 ajj = dble( ab( 1, j ) )
276 IF( ajj.LE.zero )
THEN
287 CALL zdscal( km, one / ajj, ab( km+1, j-km ), kld )
288 CALL zlacgv( km, ab( km+1, j-km ), kld )
289 CALL zher(
'Lower', km, -one, ab( km+1, j-km ), kld,
290 $ ab( 1, j-km ), kld )
291 CALL zlacgv( km, ab( km+1, j-km ), kld )
300 ajj = dble( ab( 1, j ) )
301 IF( ajj.LE.zero )
THEN
313 CALL zdscal( km, one / ajj, ab( 2, j ), 1 )
314 CALL zher(
'Lower', km, -one, ab( 2, j ), 1,
315 $ ab( 1, j+1 ), kld )