154 SUBROUTINE zpbstf( UPLO, N, KD, AB, LDAB, INFO )
163 INTEGER info, kd, ldab, n
166 COMPLEX*16 ab( ldab, * )
172 DOUBLE PRECISION one, zero
173 parameter( one = 1.0d+0, zero = 0.0d+0 )
177 INTEGER j, kld, km, m
188 INTRINSIC dble, max, min, sqrt
195 upper =
lsame( uplo,
'U' )
196 IF( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
198 ELSE IF( n.LT.0 )
THEN
200 ELSE IF( kd.LT.0 )
THEN
202 ELSE IF( ldab.LT.kd+1 )
THEN
206 CALL
xerbla(
'ZPBSTF', -info )
215 kld = max( 1, ldab-1 )
225 DO 10
j = n, m + 1, -1
229 ajj = dble( ab( kd+1,
j ) )
230 IF( ajj.LE.zero )
THEN
241 CALL
zdscal( km, one / ajj, ab( kd+1-km,
j ), 1 )
242 CALL
zher(
'Upper', km, -one, ab( kd+1-km,
j ), 1,
243 $ ab( kd+1,
j-km ), kld )
252 ajj = dble( ab( kd+1,
j ) )
253 IF( ajj.LE.zero )
THEN
265 CALL
zdscal( km, one / ajj, ab( kd,
j+1 ), kld )
266 CALL
zlacgv( km, ab( kd,
j+1 ), kld )
267 CALL
zher(
'Upper', km, -one, ab( kd,
j+1 ), kld,
268 $ ab( kd+1,
j+1 ), kld )
269 CALL
zlacgv( km, ab( kd,
j+1 ), kld )
276 DO 30
j = n, m + 1, -1
280 ajj = dble( ab( 1,
j ) )
281 IF( ajj.LE.zero )
THEN
292 CALL
zdscal( km, one / ajj, ab( km+1,
j-km ), kld )
293 CALL
zlacgv( km, ab( km+1,
j-km ), kld )
294 CALL
zher(
'Lower', km, -one, ab( km+1,
j-km ), kld,
295 $ ab( 1,
j-km ), kld )
296 CALL
zlacgv( km, ab( km+1,
j-km ), kld )
305 ajj = dble( ab( 1,
j ) )
306 IF( ajj.LE.zero )
THEN
318 CALL
zdscal( km, one / ajj, ab( 2,
j ), 1 )
319 CALL
zher(
'Lower', km, -one, ab( 2,
j ), 1,
320 $ ab( 1,
j+1 ), kld )
LOGICAL function lsame(CA, CB)
LSAME
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zlacgv(N, X, INCX)
ZLACGV conjugates a complex vector.
subroutine zpbstf(UPLO, N, KD, AB, LDAB, INFO)
ZPBSTF
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine zher(UPLO, N, ALPHA, X, INCX, A, LDA)
ZHER