LAPACK 3.12.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches

## ◆ zla_porcond_x()

 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.``` [out] WORK ``` WORK is COMPLEX*16 array, dimension (2*N). Workspace.``` [out] RWORK ``` RWORK is DOUBLE PRECISION array, dimension (N). Workspace.```

Definition at line 122 of file zla_porcond_x.f.

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