120 SUBROUTINE zpbt01( UPLO, N, KD, A, LDA, AFAC, LDAFAC, RWORK,
130 INTEGER kd, lda, ldafac, n
131 DOUBLE PRECISION resid
134 DOUBLE PRECISION rwork( * )
135 COMPLEX*16 a( lda, * ), afac( ldafac, * )
142 DOUBLE PRECISION zero, one
143 parameter( zero = 0.0d+0, one = 1.0d+0 )
146 INTEGER i,
j, k, kc, klen, ml, mu
147 DOUBLE PRECISION akk, anorm, eps
159 INTRINSIC dble, dimag, max, min
173 anorm =
zlanhb(
'1', uplo, n, kd, a, lda, rwork )
174 IF( anorm.LE.zero )
THEN
182 IF(
lsame( uplo,
'U' ) )
THEN
184 IF( dimag( afac( kd+1,
j ) ).NE.zero )
THEN
191 IF( dimag( afac( 1,
j ) ).NE.zero )
THEN
200 IF(
lsame( uplo,
'U' ) )
THEN
202 kc = max( 1, kd+2-k )
207 akk =
zdotc( klen+1, afac( kc, k ), 1, afac( kc, k ), 1 )
208 afac( kd+1, k ) = akk
213 $ CALL
ztrmv(
'Upper',
'Conjugate',
'Non-unit', klen,
214 $ afac( kd+1, k-klen ), ldafac-1,
223 klen = min( kd, n-k )
229 $ CALL
zher(
'Lower', klen, one, afac( 2, k ), 1,
230 $ afac( 1, k+1 ), ldafac-1 )
235 CALL
zdscal( klen+1, akk, afac( 1, k ), 1 )
242 IF(
lsame( uplo,
'U' ) )
THEN
244 mu = max( 1, kd+2-
j )
246 afac( i,
j ) = afac( i,
j ) - a( i,
j )
251 ml = min( kd+1, n-
j+1 )
253 afac( i,
j ) = afac( i,
j ) - a( i,
j )
260 resid =
zlanhb(
'1', uplo, n, kd, afac, ldafac, rwork )
262 resid = ( ( resid / dble( n ) ) / anorm ) / eps
LOGICAL function lsame(CA, CB)
LSAME
subroutine zpbt01(UPLO, N, KD, A, LDA, AFAC, LDAFAC, RWORK, RESID)
ZPBT01
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
DOUBLE PRECISION function zlanhb(NORM, UPLO, N, K, AB, LDAB, WORK)
ZLANHB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a Hermitian band matrix.
subroutine ztrmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
ZTRMV
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
COMPLEX *16 function zdotc(N, ZX, INCX, ZY, INCY)
ZDOTC
subroutine zher(UPLO, N, ALPHA, X, INCX, A, LDA)
ZHER