120 SUBROUTINE cpbt01( UPLO, N, KD, A, LDA, AFAC, LDAFAC, RWORK,
130 INTEGER kd, lda, ldafac, n
135 COMPLEX a( lda, * ), afac( ldafac, * )
143 parameter( zero = 0.0e+0, one = 1.0e+0 )
146 INTEGER i,
j, k, kc, klen, ml, mu
159 INTRINSIC aimag, max, min, real
173 anorm =
clanhb(
'1', uplo, n, kd, a, lda, rwork )
174 IF( anorm.LE.zero )
THEN
182 IF(
lsame( uplo,
'U' ) )
THEN
184 IF( aimag( afac( kd+1,
j ) ).NE.zero )
THEN
191 IF( aimag( afac( 1,
j ) ).NE.zero )
THEN
200 IF(
lsame( uplo,
'U' ) )
THEN
202 kc = max( 1, kd+2-k )
207 akk =
cdotc( klen+1, afac( kc, k ), 1, afac( kc, k ), 1 )
208 afac( kd+1, k ) = akk
213 $ CALL
ctrmv(
'Upper',
'Conjugate',
'Non-unit', klen,
214 $ afac( kd+1, k-klen ), ldafac-1,
223 klen = min( kd, n-k )
229 $ CALL
cher(
'Lower', klen, one, afac( 2, k ), 1,
230 $ afac( 1, k+1 ), ldafac-1 )
235 CALL
csscal( 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 =
clanhb(
'1', uplo, n, kd, afac, ldafac, rwork )
262 resid = ( ( resid /
REAL( N ) ) / anorm ) / eps
complex function cdotc(N, CX, INCX, CY, INCY)
CDOTC
subroutine cher(UPLO, N, ALPHA, X, INCX, A, LDA)
CHER
logical function lsame(CA, CB)
LSAME
real function slamch(CMACH)
SLAMCH
real function clanhb(NORM, UPLO, N, K, AB, LDAB, WORK)
CLANHB 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.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine cpbt01(UPLO, N, KD, A, LDA, AFAC, LDAFAC, RWORK, RESID)
CPBT01
subroutine ctrmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
CTRMV
subroutine csscal(N, SA, CX, INCX)
CSSCAL