LAPACK  3.9.1
LAPACK: Linear Algebra PACKage

◆ sla_porcond()

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

SLA_PORCOND estimates the Skeel condition number for a symmetric positive-definite matrix.

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

Purpose:
    SLA_PORCOND 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 triangular factor U or L from the Cholesky factorization
     A = U**T*U or A = L*L**T, as computed by SPOTRF.
[in]LDAF
          LDAF is INTEGER
     The leading dimension of the array AF.  LDAF >= max(1,N).
[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 138 of file sla_porcond.f.

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