LAPACK  3.10.1
LAPACK: Linear Algebra PACKage

◆ dla_syrcond()

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.
[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.

Definition at line 145 of file dla_syrcond.f.

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