LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ dla_gercond()

double precision function dla_gercond ( character  TRANS,
integer  N,
double precision, dimension( lda, * )  A,
integer  LDA,
double precision, dimension( ldaf, * )  AF,
integer  LDAF,
integer, dimension( * )  IPIV,
integer  CMODE,
double precision, dimension( * )  C,
integer  INFO,
double precision, dimension( * )  WORK,
integer, dimension( * )  IWORK 
)

DLA_GERCOND estimates the Skeel condition number for a general matrix.

Download DLA_GERCOND + dependencies [TGZ] [ZIP] [TXT]

Purpose:
    DLA_GERCOND estimates the Skeel condition number of op(A) * op2(C)
    where op2 is determined by CMODE as follows
    CMODE =  1    op2(C) = C
    CMODE =  0    op2(C) = I
    CMODE = -1    op2(C) = inv(C)
    The Skeel condition number cond(A) = norminf( |inv(A)||A| )
    is computed by computing scaling factors R such that
    diag(R)*A*op2(C) is row equilibrated and computing the standard
    infinity-norm condition number.
Parameters
[in]TRANS
          TRANS is CHARACTER*1
     Specifies the form of the system of equations:
       = 'N':  A * X = B     (No transpose)
       = 'T':  A**T * X = B  (Transpose)
       = 'C':  A**H * X = B  (Conjugate Transpose = Transpose)
[in]N
          N is INTEGER
     The number of linear equations, i.e., the order of the
     matrix A.  N >= 0.
[in]A
          A is DOUBLE PRECISION array, dimension (LDA,N)
     On entry, the N-by-N matrix A.
[in]LDA
          LDA is INTEGER
     The leading dimension of the array A.  LDA >= max(1,N).
[in]AF
          AF is DOUBLE PRECISION array, dimension (LDAF,N)
     The factors L and U from the factorization
     A = P*L*U as computed by DGETRF.
[in]LDAF
          LDAF is INTEGER
     The leading dimension of the array AF.  LDAF >= max(1,N).
[in]IPIV
          IPIV is INTEGER array, dimension (N)
     The pivot indices from the factorization A = P*L*U
     as computed by DGETRF; row i of the matrix was interchanged
     with row IPIV(i).
[in]CMODE
          CMODE is INTEGER
     Determines op2(C) in the formula op(A) * op2(C) as follows:
     CMODE =  1    op2(C) = C
     CMODE =  0    op2(C) = I
     CMODE = -1    op2(C) = inv(C)
[in]C
          C is DOUBLE PRECISION array, dimension (N)
     The vector C in the formula op(A) * op2(C).
[out]INFO
          INFO is INTEGER
       = 0:  Successful exit.
     i > 0:  The ith argument is invalid.
[out]WORK
          WORK is DOUBLE PRECISION array, dimension (3*N).
     Workspace.
[out]IWORK
          IWORK is INTEGER array, dimension (N).
     Workspace.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
December 2016

Definition at line 154 of file dla_gercond.f.

154 *
155 * -- LAPACK computational routine (version 3.7.0) --
156 * -- LAPACK is a software package provided by Univ. of Tennessee, --
157 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
158 * December 2016
159 *
160 * .. Scalar Arguments ..
161  CHARACTER TRANS
162  INTEGER N, LDA, LDAF, INFO, CMODE
163 * ..
164 * .. Array Arguments ..
165  INTEGER IPIV( * ), IWORK( * )
166  DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), WORK( * ),
167  $ C( * )
168 * ..
169 *
170 * =====================================================================
171 *
172 * .. Local Scalars ..
173  LOGICAL NOTRANS
174  INTEGER KASE, I, J
175  DOUBLE PRECISION AINVNM, TMP
176 * ..
177 * .. Local Arrays ..
178  INTEGER ISAVE( 3 )
179 * ..
180 * .. External Functions ..
181  LOGICAL LSAME
182  EXTERNAL lsame
183 * ..
184 * .. External Subroutines ..
185  EXTERNAL dlacn2, dgetrs, xerbla
186 * ..
187 * .. Intrinsic Functions ..
188  INTRINSIC abs, max
189 * ..
190 * .. Executable Statements ..
191 *
192  dla_gercond = 0.0d+0
193 *
194  info = 0
195  notrans = lsame( trans, 'N' )
196  IF ( .NOT. notrans .AND. .NOT. lsame(trans, 'T')
197  $ .AND. .NOT. lsame(trans, 'C') ) THEN
198  info = -1
199  ELSE IF( n.LT.0 ) THEN
200  info = -2
201  ELSE IF( lda.LT.max( 1, n ) ) THEN
202  info = -4
203  ELSE IF( ldaf.LT.max( 1, n ) ) THEN
204  info = -6
205  END IF
206  IF( info.NE.0 ) THEN
207  CALL xerbla( 'DLA_GERCOND', -info )
208  RETURN
209  END IF
210  IF( n.EQ.0 ) THEN
211  dla_gercond = 1.0d+0
212  RETURN
213  END IF
214 *
215 * Compute the equilibration matrix R such that
216 * inv(R)*A*C has unit 1-norm.
217 *
218  IF (notrans) THEN
219  DO i = 1, n
220  tmp = 0.0d+0
221  IF ( cmode .EQ. 1 ) THEN
222  DO j = 1, n
223  tmp = tmp + abs( a( i, j ) * c( j ) )
224  END DO
225  ELSE IF ( cmode .EQ. 0 ) THEN
226  DO j = 1, n
227  tmp = tmp + abs( a( i, j ) )
228  END DO
229  ELSE
230  DO j = 1, n
231  tmp = tmp + abs( a( i, j ) / c( j ) )
232  END DO
233  END IF
234  work( 2*n+i ) = tmp
235  END DO
236  ELSE
237  DO i = 1, n
238  tmp = 0.0d+0
239  IF ( cmode .EQ. 1 ) THEN
240  DO j = 1, n
241  tmp = tmp + abs( a( j, i ) * c( j ) )
242  END DO
243  ELSE IF ( cmode .EQ. 0 ) THEN
244  DO j = 1, n
245  tmp = tmp + abs( a( j, i ) )
246  END DO
247  ELSE
248  DO j = 1, n
249  tmp = tmp + abs( a( j, i ) / c( j ) )
250  END DO
251  END IF
252  work( 2*n+i ) = tmp
253  END DO
254  END IF
255 *
256 * Estimate the norm of inv(op(A)).
257 *
258  ainvnm = 0.0d+0
259 
260  kase = 0
261  10 CONTINUE
262  CALL dlacn2( n, work( n+1 ), work, iwork, ainvnm, kase, isave )
263  IF( kase.NE.0 ) THEN
264  IF( kase.EQ.2 ) THEN
265 *
266 * Multiply by R.
267 *
268  DO i = 1, n
269  work(i) = work(i) * work(2*n+i)
270  END DO
271 
272  IF (notrans) THEN
273  CALL dgetrs( 'No transpose', n, 1, af, ldaf, ipiv,
274  $ work, n, info )
275  ELSE
276  CALL dgetrs( 'Transpose', n, 1, af, ldaf, ipiv,
277  $ work, n, info )
278  END IF
279 *
280 * Multiply by inv(C).
281 *
282  IF ( cmode .EQ. 1 ) THEN
283  DO i = 1, n
284  work( i ) = work( i ) / c( i )
285  END DO
286  ELSE IF ( cmode .EQ. -1 ) THEN
287  DO i = 1, n
288  work( i ) = work( i ) * c( i )
289  END DO
290  END IF
291  ELSE
292 *
293 * Multiply by inv(C**T).
294 *
295  IF ( cmode .EQ. 1 ) THEN
296  DO i = 1, n
297  work( i ) = work( i ) / c( i )
298  END DO
299  ELSE IF ( cmode .EQ. -1 ) THEN
300  DO i = 1, n
301  work( i ) = work( i ) * c( i )
302  END DO
303  END IF
304 
305  IF (notrans) THEN
306  CALL dgetrs( 'Transpose', n, 1, af, ldaf, ipiv,
307  $ work, n, info )
308  ELSE
309  CALL dgetrs( 'No transpose', n, 1, af, ldaf, ipiv,
310  $ work, n, info )
311  END IF
312 *
313 * Multiply by R.
314 *
315  DO i = 1, n
316  work( i ) = work( i ) * work( 2*n+i )
317  END DO
318  END IF
319  GO TO 10
320  END IF
321 *
322 * Compute the estimate of the reciprocal condition number.
323 *
324  IF( ainvnm .NE. 0.0d+0 )
325  $ dla_gercond = ( 1.0d+0 / ainvnm )
326 *
327  RETURN
328 *
Here is the call graph for this function:
Here is the caller graph for this function:
dlacn2
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...
Definition: dlacn2.f:138
dla_gercond
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.
Definition: dla_gercond.f:154
dgetrs
subroutine dgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DGETRS
Definition: dgetrs.f:123
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
lsame
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55