137 SUBROUTINE strcon( NORM, UPLO, DIAG, N, A, LDA, RCOND, WORK,
146 CHARACTER DIAG, NORM, UPLO
152 REAL A( lda, * ), WORK( * )
159 parameter( one = 1.0e+0, zero = 0.0e+0 )
162 LOGICAL NOUNIT, ONENRM, UPPER
164 INTEGER IX, KASE, KASE1
165 REAL AINVNM, ANORM, SCALE, SMLNUM, XNORM
174 EXTERNAL lsame, isamax, slamch, slantr
180 INTRINSIC abs, max, real
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(
'STRCON', -info )
215 smlnum = slamch(
'Safe minimum' )*
REAL( MAX( 1, N ) )
219 anorm = slantr( norm, uplo, diag, n, n, a, lda, work )
223 IF( anorm.GT.zero )
THEN
236 CALL
slacn2( n, work( n+1 ), work, iwork, ainvnm, kase, isave )
238 IF( kase.EQ.kase1 )
THEN
242 CALL
slatrs( uplo,
'No transpose', diag, normin, n, a,
243 $ lda, work, scale, work( 2*n+1 ), info )
248 CALL
slatrs( uplo,
'Transpose', diag, normin, n, a, lda,
249 $ work, scale, work( 2*n+1 ), info )
255 IF( scale.NE.one )
THEN
256 ix = isamax( n, work, 1 )
257 xnorm = abs( work( ix ) )
258 IF( scale.LT.xnorm*smlnum .OR. scale.EQ.zero )
260 CALL
srscl( n, scale, work, 1 )
268 $ rcond = ( one / anorm ) / ainvnm
subroutine strcon(NORM, UPLO, DIAG, N, A, LDA, RCOND, WORK, IWORK, INFO)
STRCON
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine slatrs(UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, CNORM, INFO)
SLATRS solves a triangular system of equations with the scale factor set to prevent overflow...
subroutine srscl(N, SA, SX, INCX)
SRSCL multiplies a vector by the reciprocal of a real scalar.
subroutine slacn2(N, V, X, ISGN, EST, KASE, ISAVE)
SLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...