124 SUBROUTINE dgecon( NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK,
135 DOUBLE PRECISION anorm, rcond
139 DOUBLE PRECISION a( lda, * ), work( * )
145 DOUBLE PRECISION one, zero
146 parameter( one = 1.0d+0, zero = 0.0d+0 )
151 INTEGER ix, kase, kase1
152 DOUBLE PRECISION ainvnm, scale, sl, smlnum, su
174 onenrm = norm.EQ.
'1' .OR.
lsame( norm,
'O' )
175 IF( .NOT.onenrm .AND. .NOT.
lsame( norm,
'I' ) )
THEN
177 ELSE IF( n.LT.0 )
THEN
179 ELSE IF( lda.LT.max( 1, n ) )
THEN
181 ELSE IF( anorm.LT.zero )
THEN
185 CALL
xerbla(
'DGECON', -info )
195 ELSE IF( anorm.EQ.zero )
THEN
199 smlnum =
dlamch(
'Safe minimum' )
212 CALL
dlacn2( n, work( n+1 ), work, iwork, ainvnm, kase, isave )
214 IF( kase.EQ.kase1 )
THEN
218 CALL
dlatrs(
'Lower',
'No transpose',
'Unit', normin, n, a,
219 $ lda, work, sl, work( 2*n+1 ), info )
223 CALL
dlatrs(
'Upper',
'No transpose',
'Non-unit', normin, n,
224 $ a, lda, work, su, work( 3*n+1 ), info )
229 CALL
dlatrs(
'Upper',
'Transpose',
'Non-unit', normin, n, a,
230 $ lda, work, su, work( 3*n+1 ), info )
234 CALL
dlatrs(
'Lower',
'Transpose',
'Unit', normin, n, a,
235 $ lda, work, sl, work( 2*n+1 ), info )
242 IF( scale.NE.one )
THEN
244 IF( scale.LT.abs( work( ix ) )*smlnum .OR. scale.EQ.zero )
246 CALL
drscl( n, scale, work, 1 )
254 $ rcond = ( one / ainvnm ) / anorm
LOGICAL function lsame(CA, CB)
LSAME
subroutine dgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK, INFO)
DGECON
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 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