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
173 DOUBLE PRECISION DLAMCH, DLANTR
174 EXTERNAL lsame, idamax, dlamch, dlantr
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
256 ix = idamax( n, work, 1 )
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
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
subroutine drscl(N, SA, SX, INCX)
DRSCL multiplies a vector by the reciprocal of a real scalar.
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...