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.

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

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.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
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 *
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
cpotrs
subroutine cpotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
CPOTRS
Definition: cpotrs.f:112
lsame
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
cla_porcond_c
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...
Definition: cla_porcond_c.f:132
clacn2
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: