LAPACK  3.9.0
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.
Date
December 2016

Definition at line 142 of file sla_porcond.f.

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