LAPACK  3.10.1
LAPACK: Linear Algebra PACKage

◆ sla_syrcond()

real function sla_syrcond ( character  UPLO,
integer  N,
real, dimension( lda, * )  A,
integer  LDA,
real, dimension( ldaf, * )  AF,
integer  LDAF,
integer, dimension( * )  IPIV,
integer  CMODE,
real, dimension( * )  C,
integer  INFO,
real, dimension( * )  WORK,
integer, dimension( * )  IWORK 
)

SLA_SYRCOND estimates the Skeel condition number for a symmetric indefinite matrix.

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

Purpose:
    SLA_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 REAL 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 REAL array, dimension (LDAF,N)
     The block diagonal matrix D and the multipliers used to
     obtain the factor U or L as computed by SSYTRF.
[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 SSYTRF.
[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 REAL 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 REAL 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 144 of file sla_syrcond.f.

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