151 DOUBLE PRECISION FUNCTION dla_gercond ( TRANS, N, A, LDA, AF,
152 $ ldaf, ipiv, cmode, c,
153 $ info, work, iwork )
162 INTEGER N, LDA, LDAF, INFO, CMODE
165 INTEGER IPIV( * ), IWORK( * )
166 DOUBLE PRECISION A( lda, * ), AF( ldaf, * ), WORK( * ),
175 DOUBLE PRECISION AINVNM, TMP
195 notrans = lsame( trans,
'N' )
196 IF ( .NOT. notrans .AND. .NOT. lsame(trans,
'T')
197 $ .AND. .NOT. lsame(trans,
'C') )
THEN
199 ELSE IF( n.LT.0 )
THEN
201 ELSE IF( lda.LT.max( 1, n ) )
THEN
203 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
207 CALL xerbla(
'DLA_GERCOND', -info )
221 IF ( cmode .EQ. 1 )
THEN
223 tmp = tmp + abs( a( i, j ) * c( j ) )
225 ELSE IF ( cmode .EQ. 0 )
THEN
227 tmp = tmp + abs( a( i, j ) )
231 tmp = tmp + abs( a( i, j ) / c( j ) )
239 IF ( cmode .EQ. 1 )
THEN
241 tmp = tmp + abs( a( j, i ) * c( j ) )
243 ELSE IF ( cmode .EQ. 0 )
THEN
245 tmp = tmp + abs( a( j, i ) )
249 tmp = tmp + abs( a( j, i ) / c( j ) )
262 CALL dlacn2( n, work( n+1 ), work, iwork, ainvnm, kase, isave )
269 work(i) = work(i) * work(2*n+i)
273 CALL dgetrs(
'No transpose', n, 1, af, ldaf, ipiv,
276 CALL dgetrs(
'Transpose', n, 1, af, ldaf, ipiv,
282 IF ( cmode .EQ. 1 )
THEN
284 work( i ) = work( i ) / c( i )
286 ELSE IF ( cmode .EQ. -1 )
THEN
288 work( i ) = work( i ) * c( i )
295 IF ( cmode .EQ. 1 )
THEN
297 work( i ) = work( i ) / c( i )
299 ELSE IF ( cmode .EQ. -1 )
THEN
301 work( i ) = work( i ) * c( i )
306 CALL dgetrs(
'Transpose', n, 1, af, ldaf, ipiv,
309 CALL dgetrs(
'No transpose', n, 1, af, ldaf, ipiv,
316 work( i ) = work( i ) * work( 2*n+i )
324 IF( ainvnm .NE. 0.0d+0 )
double precision function dla_gercond(TRANS, N, A, LDA, AF, LDAF, IPIV, CMODE, C, INFO, WORK, IWORK)
DLA_GERCOND estimates the Skeel condition number for a general matrix.
subroutine dgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DGETRS
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...
subroutine xerbla(SRNAME, INFO)
XERBLA