133 SUBROUTINE cpbcon( UPLO, N, KD, AB, LDAB, ANORM, RCOND, WORK,
143 INTEGER INFO, KD, LDAB, N
148 COMPLEX AB( ldab, * ), WORK( * )
155 parameter ( one = 1.0e+0, zero = 0.0e+0 )
161 REAL AINVNM, SCALE, SCALEL, SCALEU, SMLNUM
171 EXTERNAL lsame, icamax, slamch
177 INTRINSIC abs, aimag, real
183 cabs1( zdum ) = abs(
REAL( ZDUM ) ) + abs( AIMAG( zdum ) )
190 upper = lsame( uplo,
'U' )
191 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
193 ELSE IF( n.LT.0 )
THEN
195 ELSE IF( kd.LT.0 )
THEN
197 ELSE IF( ldab.LT.kd+1 )
THEN
199 ELSE IF( anorm.LT.zero )
THEN
203 CALL xerbla(
'CPBCON', -info )
213 ELSE IF( anorm.EQ.zero )
THEN
217 smlnum = slamch(
'Safe minimum' )
224 CALL clacn2( n, work( n+1 ), work, ainvnm, kase, isave )
230 CALL clatbs(
'Upper',
'Conjugate transpose',
'Non-unit',
231 $ normin, n, kd, ab, ldab, work, scalel, rwork,
237 CALL clatbs(
'Upper',
'No transpose',
'Non-unit', normin, n,
238 $ kd, ab, ldab, work, scaleu, rwork, info )
243 CALL clatbs(
'Lower',
'No transpose',
'Non-unit', normin, n,
244 $ kd, ab, ldab, work, scalel, rwork, info )
249 CALL clatbs(
'Lower',
'Conjugate transpose',
'Non-unit',
250 $ normin, n, kd, ab, ldab, work, scaleu, rwork,
256 scale = scalel*scaleu
257 IF( scale.NE.one )
THEN
258 ix = icamax( n, work, 1 )
259 IF( scale.LT.cabs1( work( ix ) )*smlnum .OR. scale.EQ.zero )
261 CALL csrscl( n, scale, work, 1 )
269 $ rcond = ( one / ainvnm ) / anorm
subroutine cpbcon(UPLO, N, KD, AB, LDAB, ANORM, RCOND, WORK, RWORK, INFO)
CPBCON
subroutine csrscl(N, SA, SX, INCX)
CSRSCL multiplies a vector by the reciprocal of a real scalar.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine clatbs(UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, X, SCALE, CNORM, INFO)
CLATBS solves a triangular banded system of equations.
subroutine clacn2(N, V, X, EST, KASE, ISAVE)
CLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...