147 DOUBLE PRECISION FUNCTION dla_syrcond( UPLO, N, A, LDA, AF, LDAF,
148 $ ipiv, cmode, c, info, work,
158 INTEGER N, LDA, LDAF, INFO, CMODE
161 INTEGER IWORK( * ), IPIV( * )
162 DOUBLE PRECISION A( lda, * ), AF( ldaf, * ), WORK( * ), C( * )
170 DOUBLE PRECISION AINVNM, SMLNUM, TMP
179 DOUBLE PRECISION DLAMCH
180 EXTERNAL lsame, idamax, dlamch
195 ELSE IF( lda.LT.max( 1, n ) )
THEN
197 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
201 CALL xerbla(
'DLA_SYRCOND', -info )
209 IF ( lsame( uplo,
'U' ) ) up = .true.
217 IF ( cmode .EQ. 1 )
THEN
219 tmp = tmp + abs( a( j, i ) * c( j ) )
222 tmp = tmp + abs( a( i, j ) * c( j ) )
224 ELSE IF ( cmode .EQ. 0 )
THEN
226 tmp = tmp + abs( a( j, i ) )
229 tmp = tmp + abs( a( i, j ) )
233 tmp = tmp + abs( a( j, i ) / c( j ) )
236 tmp = tmp + abs( a( i, j ) / c( j ) )
244 IF ( cmode .EQ. 1 )
THEN
246 tmp = tmp + abs( a( i, j ) * c( j ) )
249 tmp = tmp + abs( a( j, i ) * c( j ) )
251 ELSE IF ( cmode .EQ. 0 )
THEN
253 tmp = tmp + abs( a( i, j ) )
256 tmp = tmp + abs( a( j, i ) )
260 tmp = tmp + abs( a( i, j) / c( j ) )
263 tmp = tmp + abs( a( j, i) / c( j ) )
272 smlnum = dlamch(
'Safe minimum' )
278 CALL dlacn2( n, work( n+1 ), work, iwork, ainvnm, kase, isave )
285 work( i ) = work( i ) * work( 2*n+i )
289 CALL dsytrs(
'U', n, 1, af, ldaf, ipiv, work, n, info )
291 CALL dsytrs(
'L', n, 1, af, ldaf, ipiv, work, n, info )
296 IF ( cmode .EQ. 1 )
THEN
298 work( i ) = work( i ) / c( i )
300 ELSE IF ( cmode .EQ. -1 )
THEN
302 work( i ) = work( i ) * c( i )
309 IF ( cmode .EQ. 1 )
THEN
311 work( i ) = work( i ) / c( i )
313 ELSE IF ( cmode .EQ. -1 )
THEN
315 work( i ) = work( i ) * c( i )
320 CALL dsytrs(
'U', n, 1, af, ldaf, ipiv, work, n, info )
322 CALL dsytrs(
'L', n, 1, af, ldaf, ipiv, work, n, info )
328 work( i ) = work( i ) * work( 2*n+i )
337 IF( ainvnm .NE. 0.0d+0 )
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
double precision function dla_syrcond(UPLO, N, A, LDA, AF, LDAF, IPIV, CMODE, C, INFO, WORK, IWORK)
DLA_SYRCOND estimates the Skeel condition number for a symmetric indefinite matrix.
subroutine drscl(N, SA, SX, INCX)
DRSCL multiplies a vector by the reciprocal of a real scalar.
subroutine dsytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DSYTRS
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...