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

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

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

Purpose: 
    ZLA_PORCOND_C Computes the infinity norm condition number of
    op(A) * inv(diag(C)) where C is a DOUBLE PRECISION 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*16 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*16 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 ZPOTRF.
[in]LDAF
          LDAF is INTEGER
     The leading dimension of the array AF.  LDAF >= max(1,N).
[in]C
          C is DOUBLE PRECISION 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*16 array, dimension (2*N).
     Workspace.
[in]RWORK
          RWORK is DOUBLE PRECISION array, dimension (N).
     Workspace.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
September 2012

Definition at line 134 of file zla_porcond_c.f.

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

Here is the call graph for this function:

Here is the caller graph for this function: