130 SUBROUTINE stpcon( NORM, UPLO, DIAG, N, AP, RCOND, WORK, IWORK,
139 CHARACTER diag, norm, uplo
145 REAL ap( * ), work( * )
152 parameter( one = 1.0e+0, zero = 0.0e+0 )
155 LOGICAL nounit, onenrm, upper
157 INTEGER ix, kase, kase1
158 REAL ainvnm, anorm, scale, smlnum, xnorm
173 INTRINSIC abs, max, real
180 upper =
lsame( uplo,
'U' )
181 onenrm = norm.EQ.
'1' .OR.
lsame( norm,
'O' )
182 nounit =
lsame( diag,
'N' )
184 IF( .NOT.onenrm .AND. .NOT.
lsame( norm,
'I' ) )
THEN
186 ELSE IF( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
188 ELSE IF( .NOT.nounit .AND. .NOT.
lsame( diag,
'U' ) )
THEN
190 ELSE IF( n.LT.0 )
THEN
194 CALL
xerbla(
'STPCON', -info )
206 smlnum =
slamch(
'Safe minimum' )*
REAL( MAX( 1, N ) )
210 anorm =
slantp( norm, uplo, diag, n, ap, work )
214 IF( anorm.GT.zero )
THEN
227 CALL
slacn2( n, work( n+1 ), work, iwork, ainvnm, kase, isave )
229 IF( kase.EQ.kase1 )
THEN
233 CALL
slatps( uplo,
'No transpose', diag, normin, n, ap,
234 $ work, scale, work( 2*n+1 ), info )
239 CALL
slatps( uplo,
'Transpose', diag, normin, n, ap,
240 $ work, scale, work( 2*n+1 ), info )
246 IF( scale.NE.one )
THEN
248 xnorm = abs( work( ix ) )
249 IF( scale.LT.xnorm*smlnum .OR. scale.EQ.zero )
251 CALL
srscl( n, scale, work, 1 )
259 $ rcond = ( one / anorm ) / ainvnm
integer function isamax(N, SX, INCX)
ISAMAX
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine slatps(UPLO, TRANS, DIAG, NORMIN, N, AP, X, SCALE, CNORM, INFO)
SLATPS solves a triangular system of equations with the matrix held in packed storage.
subroutine stpcon(NORM, UPLO, DIAG, N, AP, RCOND, WORK, IWORK, INFO)
STPCON
logical function lsame(CA, CB)
LSAME
real function slantp(NORM, UPLO, DIAG, N, AP, WORK)
SLANTP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a triangular matrix supplied in packed form.
subroutine srscl(N, SA, SX, INCX)
SRSCL multiplies a vector by the reciprocal of a real scalar.
real function slamch(CMACH)
SLAMCH
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...