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

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

Purpose:
```    ZLA_PORCOND_X Computes the infinity norm condition number of
op(A) * diag(X) where X is a COMPLEX*16 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] X ``` X is COMPLEX*16 array, dimension (N) The vector X in the formula op(A) * diag(X).``` [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.```
Date
September 2012

Definition at line 127 of file zla_porcond_x.f.

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

Here is the call graph for this function:

Here is the caller graph for this function: