LAPACK  3.7.0
LAPACK: Linear Algebra PACKage
double precision function dla_syrcond ( character  UPLO,
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_SYRCOND estimates the Skeel condition number for a symmetric indefinite matrix.

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

Purpose: 
    DLA_SYRCOND 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]UPLO
          UPLO is CHARACTER*1
       = 'U':  Upper triangle of A is stored;
       = 'L':  Lower triangle of A is stored.
[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 block diagonal matrix D and the multipliers used to
     obtain the factor U or L as computed by DSYTRF.
[in]LDAF
          LDAF is INTEGER
     The leading dimension of the array AF.  LDAF >= max(1,N).
[in]IPIV
          IPIV is INTEGER array, dimension (N)
     Details of the interchanges and the block structure of D
     as determined by DSYTRF.
[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.
[in]WORK
          WORK is DOUBLE PRECISION array, dimension (3*N).
     Workspace.
[in]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 150 of file dla_syrcond.f.

150 *
151 * -- LAPACK computational routine (version 3.7.0) --
152 * -- LAPACK is a software package provided by Univ. of Tennessee, --
153 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
154 * December 2016
155 *
156 * .. Scalar Arguments ..
157  CHARACTER uplo
158  INTEGER n, lda, ldaf, info, cmode
159 * ..
160 * .. Array Arguments
161  INTEGER iwork( * ), ipiv( * )
162  DOUBLE PRECISION a( lda, * ), af( ldaf, * ), work( * ), c( * )
163 * ..
164 *
165 * =====================================================================
166 *
167 * .. Local Scalars ..
168  CHARACTER normin
169  INTEGER kase, i, j
170  DOUBLE PRECISION ainvnm, smlnum, tmp
171  LOGICAL up
172 * ..
173 * .. Local Arrays ..
174  INTEGER isave( 3 )
175 * ..
176 * .. External Functions ..
177  LOGICAL lsame
178  DOUBLE PRECISION dlamch
179  EXTERNAL lsame, dlamch
180 * ..
181 * .. External Subroutines ..
182  EXTERNAL dlacn2, xerbla, dsytrs
183 * ..
184 * .. Intrinsic Functions ..
185  INTRINSIC abs, max
186 * ..
187 * .. Executable Statements ..
188 *
189  dla_syrcond = 0.0d+0
190 *
191  info = 0
192  IF( n.LT.0 ) THEN
193  info = -2
194  ELSE IF( lda.LT.max( 1, n ) ) THEN
195  info = -4
196  ELSE IF( ldaf.LT.max( 1, n ) ) THEN
197  info = -6
198  END IF
199  IF( info.NE.0 ) THEN
200  CALL xerbla( 'DLA_SYRCOND', -info )
201  RETURN
202  END IF
203  IF( n.EQ.0 ) THEN
204  dla_syrcond = 1.0d+0
205  RETURN
206  END IF
207  up = .false.
208  IF ( lsame( uplo, 'U' ) ) up = .true.
209 *
210 * Compute the equilibration matrix R such that
211 * inv(R)*A*C has unit 1-norm.
212 *
213  IF ( up ) THEN
214  DO i = 1, n
215  tmp = 0.0d+0
216  IF ( cmode .EQ. 1 ) THEN
217  DO j = 1, i
218  tmp = tmp + abs( a( j, i ) * c( j ) )
219  END DO
220  DO j = i+1, n
221  tmp = tmp + abs( a( i, j ) * c( j ) )
222  END DO
223  ELSE IF ( cmode .EQ. 0 ) THEN
224  DO j = 1, i
225  tmp = tmp + abs( a( j, i ) )
226  END DO
227  DO j = i+1, n
228  tmp = tmp + abs( a( i, j ) )
229  END DO
230  ELSE
231  DO j = 1, i
232  tmp = tmp + abs( a( j, i ) / c( j ) )
233  END DO
234  DO j = i+1, n
235  tmp = tmp + abs( a( i, j ) / c( j ) )
236  END DO
237  END IF
238  work( 2*n+i ) = tmp
239  END DO
240  ELSE
241  DO i = 1, n
242  tmp = 0.0d+0
243  IF ( cmode .EQ. 1 ) THEN
244  DO j = 1, i
245  tmp = tmp + abs( a( i, j ) * c( j ) )
246  END DO
247  DO j = i+1, n
248  tmp = tmp + abs( a( j, i ) * c( j ) )
249  END DO
250  ELSE IF ( cmode .EQ. 0 ) THEN
251  DO j = 1, i
252  tmp = tmp + abs( a( i, j ) )
253  END DO
254  DO j = i+1, n
255  tmp = tmp + abs( a( j, i ) )
256  END DO
257  ELSE
258  DO j = 1, i
259  tmp = tmp + abs( a( i, j) / c( j ) )
260  END DO
261  DO j = i+1, n
262  tmp = tmp + abs( a( j, i) / c( j ) )
263  END DO
264  END IF
265  work( 2*n+i ) = tmp
266  END DO
267  ENDIF
268 *
269 * Estimate the norm of inv(op(A)).
270 *
271  smlnum = dlamch( 'Safe minimum' )
272  ainvnm = 0.0d+0
273  normin = 'N'
274 
275  kase = 0
276  10 CONTINUE
277  CALL dlacn2( n, work( n+1 ), work, iwork, ainvnm, kase, isave )
278  IF( kase.NE.0 ) THEN
279  IF( kase.EQ.2 ) THEN
280 *
281 * Multiply by R.
282 *
283  DO i = 1, n
284  work( i ) = work( i ) * work( 2*n+i )
285  END DO
286 
287  IF ( up ) THEN
288  CALL dsytrs( 'U', n, 1, af, ldaf, ipiv, work, n, info )
289  ELSE
290  CALL dsytrs( 'L', n, 1, af, ldaf, ipiv, work, n, info )
291  ENDIF
292 *
293 * Multiply by inv(C).
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  ELSE
305 *
306 * Multiply by inv(C**T).
307 *
308  IF ( cmode .EQ. 1 ) THEN
309  DO i = 1, n
310  work( i ) = work( i ) / c( i )
311  END DO
312  ELSE IF ( cmode .EQ. -1 ) THEN
313  DO i = 1, n
314  work( i ) = work( i ) * c( i )
315  END DO
316  END IF
317 
318  IF ( up ) THEN
319  CALL dsytrs( 'U', n, 1, af, ldaf, ipiv, work, n, info )
320  ELSE
321  CALL dsytrs( 'L', n, 1, af, ldaf, ipiv, work, n, info )
322  ENDIF
323 *
324 * Multiply by R.
325 *
326  DO i = 1, n
327  work( i ) = work( i ) * work( 2*n+i )
328  END DO
329  END IF
330 *
331  GO TO 10
332  END IF
333 *
334 * Compute the estimate of the reciprocal condition number.
335 *
336  IF( ainvnm .NE. 0.0d+0 )
337  $ dla_syrcond = ( 1.0d+0 / ainvnm )
338 *
339  RETURN
340 *
dlamch
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
dla_syrcond
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.
Definition: dla_syrcond.f:150
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
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
dsytrs
subroutine dsytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DSYTRS
Definition: dsytrs.f:122
lsame
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55

Here is the call graph for this function:

Here is the caller graph for this function: