119 SUBROUTINE cpocon( UPLO, N, A, LDA, ANORM, RCOND, WORK, RWORK,
133 COMPLEX A( LDA, * ), WORK( * )
140 parameter( one = 1.0e+0, zero = 0.0e+0 )
146 REAL AINVNM, SCALE, SCALEL, SCALEU, SMLNUM
156 EXTERNAL lsame, icamax, slamch
162 INTRINSIC abs, aimag, max, real
168 cabs1( zdum ) = abs( real( zdum ) ) + abs( aimag( zdum ) )
175 upper = lsame( uplo,
'U' )
176 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
178 ELSE IF( n.LT.0 )
THEN
180 ELSE IF( lda.LT.max( 1, n ) )
THEN
182 ELSE IF( anorm.LT.zero )
THEN
186 CALL xerbla(
'CPOCON', -info )
196 ELSE IF( anorm.EQ.zero )
THEN
200 smlnum = slamch(
'Safe minimum' )
207 CALL clacn2( n, work( n+1 ), work, ainvnm, kase, isave )
213 CALL clatrs(
'Upper',
'Conjugate transpose',
'Non-unit',
214 $ normin, n, a, lda, work, scalel, rwork, info )
219 CALL clatrs(
'Upper',
'No transpose',
'Non-unit', normin, n,
220 $ a, lda, work, scaleu, rwork, info )
225 CALL clatrs(
'Lower',
'No transpose',
'Non-unit', normin, n,
226 $ a, lda, work, scalel, rwork, info )
231 CALL clatrs(
'Lower',
'Conjugate transpose',
'Non-unit',
232 $ normin, n, a, lda, work, scaleu, rwork, info )
237 scale = scalel*scaleu
238 IF( scale.NE.one )
THEN
239 ix = icamax( n, work, 1 )
240 IF( scale.LT.cabs1( work( ix ) )*smlnum .OR. scale.EQ.zero )
242 CALL csrscl( n, scale, work, 1 )
250 $ rcond = ( one / ainvnm ) / anorm
subroutine xerbla(srname, info)
subroutine clacn2(n, v, x, est, kase, isave)
CLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...
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 cpocon(uplo, n, a, lda, anorm, rcond, work, rwork, info)
CPOCON
subroutine csrscl(n, sa, sx, incx)
CSRSCL multiplies a vector by the reciprocal of a real scalar.