118 SUBROUTINE cpbt01( UPLO, N, KD, A, LDA, AFAC, LDAFAC, RWORK,
127 INTEGER KD, LDA, LDAFAC, N
132 COMPLEX A( LDA, * ), AFAC( LDAFAC, * )
140 parameter( zero = 0.0e+0, one = 1.0e+0 )
143 INTEGER I, J, K, KC, KLEN, ML, MU
150 EXTERNAL lsame, clanhb, slamch, cdotc
156 INTRINSIC aimag, max, min, real
169 eps = slamch(
'Epsilon' )
170 anorm = clanhb(
'1', uplo, n, kd, a, lda, rwork )
171 IF( anorm.LE.zero )
THEN
179 IF( lsame( uplo,
'U' ) )
THEN
181 IF( aimag( afac( kd+1, j ) ).NE.zero )
THEN
188 IF( aimag( afac( 1, j ) ).NE.zero )
THEN
197 IF( lsame( uplo,
'U' ) )
THEN
199 kc = max( 1, kd+2-k )
204 akk = cdotc( klen+1, afac( kc, k ), 1, afac( kc, k ), 1 )
205 afac( kd+1, k ) = akk
210 $
CALL ctrmv(
'Upper',
'Conjugate',
'Non-unit', klen,
211 $ afac( kd+1, k-klen ), ldafac-1,
220 klen = min( kd, n-k )
226 $
CALL cher(
'Lower', klen, one, afac( 2, k ), 1,
227 $ afac( 1, k+1 ), ldafac-1 )
232 CALL csscal( klen+1, akk, afac( 1, k ), 1 )
239 IF( lsame( uplo,
'U' ) )
THEN
241 mu = max( 1, kd+2-j )
243 afac( i, j ) = afac( i, j ) - a( i, j )
248 ml = min( kd+1, n-j+1 )
250 afac( i, j ) = afac( i, j ) - a( i, j )
257 resid = clanhb(
'1', uplo, n, kd, afac, ldafac, rwork )
259 resid = ( ( resid / real( n ) ) / anorm ) / eps
subroutine csscal(N, SA, CX, INCX)
CSSCAL
subroutine ctrmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
CTRMV
subroutine cher(UPLO, N, ALPHA, X, INCX, A, LDA)
CHER
subroutine cpbt01(UPLO, N, KD, A, LDA, AFAC, LDAFAC, RWORK, RESID)
CPBT01