121 SUBROUTINE cpocon( UPLO, N, A, LDA, ANORM, RCOND, WORK, RWORK,
136 COMPLEX a( lda, * ), work( * )
143 parameter( one = 1.0e+0, zero = 0.0e+0 )
149 REAL ainvnm, scale, scalel, scaleu, smlnum
165 INTRINSIC abs, aimag, max, real
171 cabs1( zdum ) = abs(
REAL( ZDUM ) ) + abs( aimag( zdum ) )
178 upper =
lsame( uplo,
'U' )
179 IF( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
181 ELSE IF( n.LT.0 )
THEN
183 ELSE IF( lda.LT.max( 1, n ) )
THEN
185 ELSE IF( anorm.LT.zero )
THEN
189 CALL
xerbla(
'CPOCON', -info )
199 ELSE IF( anorm.EQ.zero )
THEN
203 smlnum =
slamch(
'Safe minimum' )
210 CALL
clacn2( n, work( n+1 ), work, ainvnm, kase, isave )
216 CALL
clatrs(
'Upper',
'Conjugate transpose',
'Non-unit',
217 $ normin, n, a, lda, work, scalel, rwork, info )
222 CALL
clatrs(
'Upper',
'No transpose',
'Non-unit', normin, n,
223 $ a, lda, work, scaleu, rwork, info )
228 CALL
clatrs(
'Lower',
'No transpose',
'Non-unit', normin, n,
229 $ a, lda, work, scalel, rwork, info )
234 CALL
clatrs(
'Lower',
'Conjugate transpose',
'Non-unit',
235 $ normin, n, a, lda, work, scaleu, rwork, info )
240 scale = scalel*scaleu
241 IF( scale.NE.one )
THEN
243 IF( scale.LT.cabs1( work( ix ) )*smlnum .OR. scale.EQ.zero )
245 CALL
csrscl( n, scale, work, 1 )
253 $ rcond = ( one / ainvnm ) / anorm
LOGICAL function lsame(CA, CB)
LSAME
REAL function slamch(CMACH)
SLAMCH
subroutine cpocon(UPLO, N, A, LDA, ANORM, RCOND, WORK, RWORK, INFO)
CPOCON
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine csrscl(N, SA, SX, INCX)
CSRSCL multiplies a vector by the reciprocal of a real scalar.
subroutine clatrs(UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, CNORM, INFO)
CLATRS solves a triangular system of equations with the scale factor set to prevent overflow...
subroutine clacn2(N, V, X, EST, KASE, ISAVE)
CLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...
INTEGER function icamax(N, CX, INCX)
ICAMAX