LAPACK  3.6.1 LAPACK: Linear Algebra PACKage
 real function cla_porcond_c ( character UPLO, integer N, complex, dimension( lda, * ) A, integer LDA, complex, dimension( ldaf, * ) AF, integer LDAF, real, dimension( * ) C, logical CAPPLY, integer INFO, complex, dimension( * ) WORK, real, dimension( * ) RWORK )

CLA_PORCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for Hermitian positive-definite matrices.

Purpose:
```    CLA_PORCOND_C Computes the infinity norm condition number of
op(A) * inv(diag(C)) where C is a REAL vector```
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 COMPLEX 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 COMPLEX array, dimension (LDAF,N) The triangular factor U or L from the Cholesky factorization A = U**H*U or A = L*L**H, as computed by CPOTRF.``` [in] LDAF ``` LDAF is INTEGER The leading dimension of the array AF. LDAF >= max(1,N).``` [in] C ``` C is REAL array, dimension (N) The vector C in the formula op(A) * inv(diag(C)).``` [in] CAPPLY ``` CAPPLY is LOGICAL If .TRUE. then access the vector C in the formula above.``` [out] INFO ``` INFO is INTEGER = 0: Successful exit. i > 0: The ith argument is invalid.``` [in] WORK ``` WORK is COMPLEX array, dimension (2*N). Workspace.``` [in] RWORK ``` RWORK is REAL array, dimension (N). Workspace.```
Date
June 2016

Definition at line 132 of file cla_porcond_c.f.

132 *
133 * -- LAPACK computational routine (version 3.6.1) --
134 * -- LAPACK is a software package provided by Univ. of Tennessee, --
135 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
136 * June 2016
137 *
138 * .. Scalar Arguments ..
139  CHARACTER uplo
140  LOGICAL capply
141  INTEGER n, lda, ldaf, info
142 * ..
143 * .. Array Arguments ..
144  COMPLEX a( lda, * ), af( ldaf, * ), work( * )
145  REAL c( * ), rwork( * )
146 * ..
147 *
148 * =====================================================================
149 *
150 * .. Local Scalars ..
151  INTEGER kase
152  REAL ainvnm, anorm, tmp
153  INTEGER i, j
154  LOGICAL up, upper
155  COMPLEX zdum
156 * ..
157 * .. Local Arrays ..
158  INTEGER isave( 3 )
159 * ..
160 * .. External Functions ..
161  LOGICAL lsame
162  EXTERNAL lsame
163 * ..
164 * .. External Subroutines ..
165  EXTERNAL clacn2, cpotrs, xerbla
166 * ..
167 * .. Intrinsic Functions ..
168  INTRINSIC abs, max, REAL, aimag
169 * ..
170 * .. Statement Functions ..
171  REAL cabs1
172 * ..
173 * .. Statement Function Definitions ..
174  cabs1( zdum ) = abs( REAL( ZDUM ) ) + abs( aimag( zdum ) )
175 * ..
176 * .. Executable Statements ..
177 *
178  cla_porcond_c = 0.0e+0
179 *
180  info = 0
181  upper = lsame( uplo, 'U' )
182  IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
183  info = -1
184  ELSE IF( n.LT.0 ) THEN
185  info = -2
186  ELSE IF( lda.LT.max( 1, n ) ) THEN
187  info = -4
188  ELSE IF( ldaf.LT.max( 1, n ) ) THEN
189  info = -6
190  END IF
191  IF( info.NE.0 ) THEN
192  CALL xerbla( 'CLA_PORCOND_C', -info )
193  RETURN
194  END IF
195  up = .false.
196  IF ( lsame( uplo, 'U' ) ) up = .true.
197 *
198 * Compute norm of op(A)*op2(C).
199 *
200  anorm = 0.0e+0
201  IF ( up ) THEN
202  DO i = 1, n
203  tmp = 0.0e+0
204  IF ( capply ) THEN
205  DO j = 1, i
206  tmp = tmp + cabs1( a( j, i ) ) / c( j )
207  END DO
208  DO j = i+1, n
209  tmp = tmp + cabs1( a( i, j ) ) / c( j )
210  END DO
211  ELSE
212  DO j = 1, i
213  tmp = tmp + cabs1( a( j, i ) )
214  END DO
215  DO j = i+1, n
216  tmp = tmp + cabs1( a( i, j ) )
217  END DO
218  END IF
219  rwork( i ) = tmp
220  anorm = max( anorm, tmp )
221  END DO
222  ELSE
223  DO i = 1, n
224  tmp = 0.0e+0
225  IF ( capply ) THEN
226  DO j = 1, i
227  tmp = tmp + cabs1( a( i, j ) ) / c( j )
228  END DO
229  DO j = i+1, n
230  tmp = tmp + cabs1( a( j, i ) ) / c( j )
231  END DO
232  ELSE
233  DO j = 1, i
234  tmp = tmp + cabs1( a( i, j ) )
235  END DO
236  DO j = i+1, n
237  tmp = tmp + cabs1( a( j, i ) )
238  END DO
239  END IF
240  rwork( i ) = tmp
241  anorm = max( anorm, tmp )
242  END DO
243  END IF
244 *
245 * Quick return if possible.
246 *
247  IF( n.EQ.0 ) THEN
248  cla_porcond_c = 1.0e+0
249  RETURN
250  ELSE IF( anorm .EQ. 0.0e+0 ) THEN
251  RETURN
252  END IF
253 *
254 * Estimate the norm of inv(op(A)).
255 *
256  ainvnm = 0.0e+0
257 *
258  kase = 0
259  10 CONTINUE
260  CALL clacn2( n, work( n+1 ), work, 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 ) * rwork( i )
268  END DO
269 *
270  IF ( up ) THEN
271  CALL cpotrs( 'U', n, 1, af, ldaf,
272  \$ work, n, info )
273  ELSE
274  CALL cpotrs( 'L', n, 1, af, ldaf,
275  \$ work, n, info )
276  ENDIF
277 *
278 * Multiply by inv(C).
279 *
280  IF ( capply ) THEN
281  DO i = 1, n
282  work( i ) = work( i ) * c( i )
283  END DO
284  END IF
285  ELSE
286 *
287 * Multiply by inv(C**H).
288 *
289  IF ( capply ) THEN
290  DO i = 1, n
291  work( i ) = work( i ) * c( i )
292  END DO
293  END IF
294 *
295  IF ( up ) THEN
296  CALL cpotrs( 'U', n, 1, af, ldaf,
297  \$ work, n, info )
298  ELSE
299  CALL cpotrs( 'L', n, 1, af, ldaf,
300  \$ work, n, info )
301  END IF
302 *
303 * Multiply by R.
304 *
305  DO i = 1, n
306  work( i ) = work( i ) * rwork( i )
307  END DO
308  END IF
309  GO TO 10
310  END IF
311 *
312 * Compute the estimate of the reciprocal condition number.
313 *
314  IF( ainvnm .NE. 0.0e+0 )
315  \$ cla_porcond_c = 1.0e+0 / ainvnm
316 *
317  RETURN
318 *
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine cpotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
CPOTRS
Definition: cpotrs.f:112
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
real function cla_porcond_c(UPLO, N, A, LDA, AF, LDAF, C, CAPPLY, INFO, WORK, RWORK)
CLA_PORCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for Hermitian positiv...
subroutine clacn2(N, V, X, EST, KASE, ISAVE)
CLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...
Definition: clacn2.f:135

Here is the call graph for this function:

Here is the caller graph for this function: