137 SUBROUTINE dtrcon( NORM, UPLO, DIAG, N, A, LDA, RCOND, WORK,
146 CHARACTER diag, norm, uplo
148 DOUBLE PRECISION rcond
152 DOUBLE PRECISION a( lda, * ), work( * )
158 DOUBLE PRECISION one, zero
159 parameter( one = 1.0d+0, zero = 0.0d+0 )
162 LOGICAL nounit, onenrm, upper
164 INTEGER ix, kase, kase1
165 DOUBLE PRECISION ainvnm, anorm, scale, smlnum, xnorm
180 INTRINSIC abs, dble, max
187 upper =
lsame( uplo,
'U' )
188 onenrm = norm.EQ.
'1' .OR.
lsame( norm,
'O' )
189 nounit =
lsame( diag,
'N' )
191 IF( .NOT.onenrm .AND. .NOT.
lsame( norm,
'I' ) )
THEN
193 ELSE IF( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
195 ELSE IF( .NOT.nounit .AND. .NOT.
lsame( diag,
'U' ) )
THEN
197 ELSE IF( n.LT.0 )
THEN
199 ELSE IF( lda.LT.max( 1, n ) )
THEN
203 CALL
xerbla(
'DTRCON', -info )
215 smlnum =
dlamch(
'Safe minimum' )*dble( max( 1, n ) )
219 anorm =
dlantr( norm, uplo, diag, n, n, a, lda, work )
223 IF( anorm.GT.zero )
THEN
236 CALL
dlacn2( n, work( n+1 ), work, iwork, ainvnm, kase, isave )
238 IF( kase.EQ.kase1 )
THEN
242 CALL
dlatrs( uplo,
'No transpose', diag, normin, n, a,
243 $ lda, work, scale, work( 2*n+1 ), info )
248 CALL
dlatrs( uplo,
'Transpose', diag, normin, n, a, lda,
249 $ work, scale, work( 2*n+1 ), info )
255 IF( scale.NE.one )
THEN
257 xnorm = abs( work( ix ) )
258 IF( scale.LT.xnorm*smlnum .OR. scale.EQ.zero )
260 CALL
drscl( n, scale, work, 1 )
268 $ rcond = ( one / anorm ) / ainvnm
LOGICAL function lsame(CA, CB)
LSAME
subroutine dlatrs(UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, CNORM, INFO)
DLATRS solves a triangular system of equations with the scale factor set to prevent overflow...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dtrcon(NORM, UPLO, DIAG, N, A, LDA, RCOND, WORK, IWORK, INFO)
DTRCON
DOUBLE PRECISION function dlantr(NORM, UPLO, DIAG, M, N, A, LDA, WORK)
DLANTR returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a trapezoidal or triangular matrix.
subroutine dlacn2(N, V, X, ISGN, EST, KASE, ISAVE)
DLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
subroutine drscl(N, SA, SX, INCX)
DRSCL multiplies a vector by the reciprocal of a real scalar.
INTEGER function idamax(N, DX, INCX)
IDAMAX