121 SUBROUTINE spocon( UPLO, N, A, LDA, ANORM, RCOND, WORK, IWORK,
136 REAL A( lda, * ), WORK( * )
143 parameter ( one = 1.0e+0, zero = 0.0e+0 )
149 REAL AINVNM, SCALE, SCALEL, SCALEU, SMLNUM
158 EXTERNAL lsame, isamax, slamch
171 upper = lsame( uplo,
'U' )
172 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
174 ELSE IF( n.LT.0 )
THEN
176 ELSE IF( lda.LT.max( 1, n ) )
THEN
178 ELSE IF( anorm.LT.zero )
THEN
182 CALL xerbla(
'SPOCON', -info )
192 ELSE IF( anorm.EQ.zero )
THEN
196 smlnum = slamch(
'Safe minimum' )
203 CALL slacn2( n, work( n+1 ), work, iwork, ainvnm, kase, isave )
209 CALL slatrs(
'Upper',
'Transpose',
'Non-unit', normin, n, a,
210 $ lda, work, scalel, work( 2*n+1 ), info )
215 CALL slatrs(
'Upper',
'No transpose',
'Non-unit', normin, n,
216 $ a, lda, work, scaleu, work( 2*n+1 ), info )
221 CALL slatrs(
'Lower',
'No transpose',
'Non-unit', normin, n,
222 $ a, lda, work, scalel, work( 2*n+1 ), info )
227 CALL slatrs(
'Lower',
'Transpose',
'Non-unit', normin, n, a,
228 $ lda, work, scaleu, work( 2*n+1 ), info )
233 scale = scalel*scaleu
234 IF( scale.NE.one )
THEN
235 ix = isamax( n, work, 1 )
236 IF( scale.LT.abs( work( ix ) )*smlnum .OR. scale.EQ.zero )
238 CALL srscl( n, scale, work, 1 )
246 $ rcond = ( one / ainvnm ) / anorm
subroutine srscl(N, SA, SX, INCX)
SRSCL multiplies a vector by the reciprocal of a real scalar.
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 xerbla(SRNAME, INFO)
XERBLA
subroutine spocon(UPLO, N, A, LDA, ANORM, RCOND, WORK, IWORK, INFO)
SPOCON
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...