148 $ LDAF, IPIV, CMODE, C,
149 $ INFO, WORK, IWORK )
157 INTEGER n, lda, ldaf, info, cmode
160 INTEGER ipiv( * ), iwork( * )
161 DOUBLE PRECISION a( lda, * ), af( ldaf, * ), work( * ),
170 DOUBLE PRECISION ainvnm, tmp
190 notrans =
lsame( trans,
'N' )
191 IF ( .NOT. notrans .AND. .NOT.
lsame(trans,
'T')
192 $ .AND. .NOT.
lsame(trans,
'C') )
THEN
194 ELSE IF( n.LT.0 )
THEN
196 ELSE IF( lda.LT.max( 1, n ) )
THEN
198 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
202 CALL xerbla(
'DLA_GERCOND', -info )
216 IF ( cmode .EQ. 1 )
THEN
218 tmp = tmp + abs( a( i, j ) * c( j ) )
220 ELSE IF ( cmode .EQ. 0 )
THEN
222 tmp = tmp + abs( a( i, j ) )
226 tmp = tmp + abs( a( i, j ) / c( j ) )
234 IF ( cmode .EQ. 1 )
THEN
236 tmp = tmp + abs( a( j, i ) * c( j ) )
238 ELSE IF ( cmode .EQ. 0 )
THEN
240 tmp = tmp + abs( a( j, i ) )
244 tmp = tmp + abs( a( j, i ) / c( j ) )
257 CALL dlacn2( n, work( n+1 ), work, iwork, ainvnm, kase, isave )
264 work(i) = work(i) * work(2*n+i)
268 CALL dgetrs(
'No transpose', n, 1, af, ldaf, ipiv,
271 CALL dgetrs(
'Transpose', n, 1, af, ldaf, ipiv,
277 IF ( cmode .EQ. 1 )
THEN
279 work( i ) = work( i ) / c( i )
281 ELSE IF ( cmode .EQ. -1 )
THEN
283 work( i ) = work( i ) * c( i )
290 IF ( cmode .EQ. 1 )
THEN
292 work( i ) = work( i ) / c( i )
294 ELSE IF ( cmode .EQ. -1 )
THEN
296 work( i ) = work( i ) * c( i )
301 CALL dgetrs(
'Transpose', n, 1, af, ldaf, ipiv,
304 CALL dgetrs(
'No transpose', n, 1, af, ldaf, ipiv,
311 work( i ) = work( i ) * work( 2*n+i )
319 IF( ainvnm .NE. 0.0d+0 )
subroutine dgetrs(trans, n, nrhs, a, lda, ipiv, b, ldb, info)
DGETRS
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 dlacn2(n, v, x, isgn, est, kase, isave)
DLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...