LAPACK  3.6.1
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
September 2012

Definition at line 150 of file dla_syrcond.f.

150 *
151 * -- LAPACK computational routine (version 3.4.2) --
152 * -- LAPACK is a software package provided by Univ. of Tennessee, --
153 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
154 * September 2012
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  INTEGER idamax
179  DOUBLE PRECISION dlamch
180  EXTERNAL lsame, idamax, dlamch
181 * ..
182 * .. External Subroutines ..
183  EXTERNAL dlacn2, dlatrs, drscl, xerbla, dsytrs
184 * ..
185 * .. Intrinsic Functions ..
186  INTRINSIC abs, max
187 * ..
188 * .. Executable Statements ..
189 *
190  dla_syrcond = 0.0d+0
191 *
192  info = 0
193  IF( n.LT.0 ) THEN
194  info = -2
195  ELSE IF( lda.LT.max( 1, n ) ) THEN
196  info = -4
197  ELSE IF( ldaf.LT.max( 1, n ) ) THEN
198  info = -6
199  END IF
200  IF( info.NE.0 ) THEN
201  CALL xerbla( 'DLA_SYRCOND', -info )
202  RETURN
203  END IF
204  IF( n.EQ.0 ) THEN
205  dla_syrcond = 1.0d+0
206  RETURN
207  END IF
208  up = .false.
209  IF ( lsame( uplo, 'U' ) ) up = .true.
210 *
211 * Compute the equilibration matrix R such that
212 * inv(R)*A*C has unit 1-norm.
213 *
214  IF ( up ) THEN
215  DO i = 1, n
216  tmp = 0.0d+0
217  IF ( cmode .EQ. 1 ) THEN
218  DO j = 1, i
219  tmp = tmp + abs( a( j, i ) * c( j ) )
220  END DO
221  DO j = i+1, n
222  tmp = tmp + abs( a( i, j ) * c( j ) )
223  END DO
224  ELSE IF ( cmode .EQ. 0 ) THEN
225  DO j = 1, i
226  tmp = tmp + abs( a( j, i ) )
227  END DO
228  DO j = i+1, n
229  tmp = tmp + abs( a( i, j ) )
230  END DO
231  ELSE
232  DO j = 1, i
233  tmp = tmp + abs( a( j, i ) / c( j ) )
234  END DO
235  DO j = i+1, n
236  tmp = tmp + abs( a( i, j ) / c( j ) )
237  END DO
238  END IF
239  work( 2*n+i ) = tmp
240  END DO
241  ELSE
242  DO i = 1, n
243  tmp = 0.0d+0
244  IF ( cmode .EQ. 1 ) THEN
245  DO j = 1, i
246  tmp = tmp + abs( a( i, j ) * c( j ) )
247  END DO
248  DO j = i+1, n
249  tmp = tmp + abs( a( j, i ) * c( j ) )
250  END DO
251  ELSE IF ( cmode .EQ. 0 ) THEN
252  DO j = 1, i
253  tmp = tmp + abs( a( i, j ) )
254  END DO
255  DO j = i+1, n
256  tmp = tmp + abs( a( j, i ) )
257  END DO
258  ELSE
259  DO j = 1, i
260  tmp = tmp + abs( a( i, j) / c( j ) )
261  END DO
262  DO j = i+1, n
263  tmp = tmp + abs( a( j, i) / c( j ) )
264  END DO
265  END IF
266  work( 2*n+i ) = tmp
267  END DO
268  ENDIF
269 *
270 * Estimate the norm of inv(op(A)).
271 *
272  smlnum = dlamch( 'Safe minimum' )
273  ainvnm = 0.0d+0
274  normin = 'N'
275 
276  kase = 0
277  10 CONTINUE
278  CALL dlacn2( n, work( n+1 ), work, iwork, ainvnm, kase, isave )
279  IF( kase.NE.0 ) THEN
280  IF( kase.EQ.2 ) THEN
281 *
282 * Multiply by R.
283 *
284  DO i = 1, n
285  work( i ) = work( i ) * work( 2*n+i )
286  END DO
287 
288  IF ( up ) THEN
289  CALL dsytrs( 'U', n, 1, af, ldaf, ipiv, work, n, info )
290  ELSE
291  CALL dsytrs( 'L', n, 1, af, ldaf, ipiv, work, n, info )
292  ENDIF
293 *
294 * Multiply by inv(C).
295 *
296  IF ( cmode .EQ. 1 ) THEN
297  DO i = 1, n
298  work( i ) = work( i ) / c( i )
299  END DO
300  ELSE IF ( cmode .EQ. -1 ) THEN
301  DO i = 1, n
302  work( i ) = work( i ) * c( i )
303  END DO
304  END IF
305  ELSE
306 *
307 * Multiply by inv(C**T).
308 *
309  IF ( cmode .EQ. 1 ) THEN
310  DO i = 1, n
311  work( i ) = work( i ) / c( i )
312  END DO
313  ELSE IF ( cmode .EQ. -1 ) THEN
314  DO i = 1, n
315  work( i ) = work( i ) * c( i )
316  END DO
317  END IF
318 
319  IF ( up ) THEN
320  CALL dsytrs( 'U', n, 1, af, ldaf, ipiv, work, n, info )
321  ELSE
322  CALL dsytrs( 'L', n, 1, af, ldaf, ipiv, work, n, info )
323  ENDIF
324 *
325 * Multiply by R.
326 *
327  DO i = 1, n
328  work( i ) = work( i ) * work( 2*n+i )
329  END DO
330  END IF
331 *
332  GO TO 10
333  END IF
334 *
335 * Compute the estimate of the reciprocal condition number.
336 *
337  IF( ainvnm .NE. 0.0d+0 )
338  $ dla_syrcond = ( 1.0d+0 / ainvnm )
339 *
340  RETURN
341 *
idamax
integer function idamax(N, DX, INCX)
IDAMAX
Definition: idamax.f:53
dlamch
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
dlatrs
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...
Definition: dlatrs.f:240
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
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
drscl
subroutine drscl(N, SA, SX, INCX)
DRSCL multiplies a vector by the reciprocal of a real scalar.
Definition: drscl.f:86
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
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

Here is the call graph for this function:

Here is the caller graph for this function: