154 SUBROUTINE cpbstf( UPLO, N, KD, AB, LDAB, INFO )
163 INTEGER info, kd, ldab, n
166 COMPLEX ab( ldab, * )
173 parameter( one = 1.0e+0, zero = 0.0e+0 )
177 INTEGER j, kld, km, m
188 INTRINSIC max, min,
REAL, 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(
'CPBSTF', -info )
215 kld = max( 1, ldab-1 )
225 DO 10
j = n, m + 1, -1
229 ajj =
REAL( AB( KD+1, J ) )
230 IF( ajj.LE.zero )
THEN
241 CALL
csscal( km, one / ajj, ab( kd+1-km,
j ), 1 )
242 CALL
cher(
'Upper', km, -one, ab( kd+1-km,
j ), 1,
243 $ ab( kd+1,
j-km ), kld )
252 ajj =
REAL( AB( KD+1, J ) )
253 IF( ajj.LE.zero )
THEN
265 CALL
csscal( km, one / ajj, ab( kd,
j+1 ), kld )
266 CALL
clacgv( km, ab( kd,
j+1 ), kld )
267 CALL
cher(
'Upper', km, -one, ab( kd,
j+1 ), kld,
268 $ ab( kd+1,
j+1 ), kld )
269 CALL
clacgv( km, ab( kd,
j+1 ), kld )
276 DO 30
j = n, m + 1, -1
280 ajj =
REAL( AB( 1, J ) )
281 IF( ajj.LE.zero )
THEN
292 CALL
csscal( km, one / ajj, ab( km+1,
j-km ), kld )
293 CALL
clacgv( km, ab( km+1,
j-km ), kld )
294 CALL
cher(
'Lower', km, -one, ab( km+1,
j-km ), kld,
295 $ ab( 1,
j-km ), kld )
296 CALL
clacgv( km, ab( km+1,
j-km ), kld )
305 ajj =
REAL( AB( 1, J ) )
306 IF( ajj.LE.zero )
THEN
318 CALL
csscal( km, one / ajj, ab( 2,
j ), 1 )
319 CALL
cher(
'Lower', km, -one, ab( 2,
j ), 1,
320 $ ab( 1,
j+1 ), kld )
subroutine cpbstf(UPLO, N, KD, AB, LDAB, INFO)
CPBSTF
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cher(UPLO, N, ALPHA, X, INCX, A, LDA)
CHER
logical function lsame(CA, CB)
LSAME
subroutine clacgv(N, X, INCX)
CLACGV conjugates a complex vector.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine csscal(N, SA, CX, INCX)
CSSCAL