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

## ◆ zla_syrcond_x()

 double precision function zla_syrcond_x ( character uplo, integer n, complex*16, dimension( lda, * ) a, integer lda, complex*16, dimension( ldaf, * ) af, integer ldaf, integer, dimension( * ) ipiv, complex*16, dimension( * ) x, integer info, complex*16, dimension( * ) work, double precision, dimension( * ) rwork )

ZLA_SYRCOND_X computes the infinity norm condition number of op(A)*diag(x) for symmetric indefinite matrices.

Purpose:
```    ZLA_SYRCOND_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 block diagonal matrix D and the multipliers used to obtain the factor U or L as computed by ZSYTRF.``` [in] LDAF ``` LDAF is INTEGER The leading dimension of the array AF. LDAF >= max(1,N).``` [in] IPIV ``` IPIV is INTEGER array, dimension (N) Details of the interchanges and the block structure of D as determined by ZSYTRF.``` [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 130 of file zla_syrcond_x.f.

133*
134* -- LAPACK computational routine --
135* -- LAPACK is a software package provided by Univ. of Tennessee, --
136* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
137*
138* .. Scalar Arguments ..
139 CHARACTER UPLO
140 INTEGER N, LDA, LDAF, INFO
141* ..
142* .. Array Arguments ..
143 INTEGER IPIV( * )
144 COMPLEX*16 A( LDA, * ), AF( LDAF, * ), WORK( * ), X( * )
145 DOUBLE PRECISION RWORK( * )
146* ..
147*
148* =====================================================================
149*
150* .. Local Scalars ..
151 INTEGER KASE
152 DOUBLE PRECISION AINVNM, ANORM, TMP
153 INTEGER I, J
154 LOGICAL UP, UPPER
155 COMPLEX*16 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 zlacn2, zsytrs, xerbla
166* ..
167* .. Intrinsic Functions ..
168 INTRINSIC abs, max
169* ..
170* .. Statement Functions ..
171 DOUBLE PRECISION CABS1
172* ..
173* .. Statement Function Definitions ..
174 cabs1( zdum ) = abs( dble( zdum ) ) + abs( dimag( zdum ) )
175* ..
176* .. Executable Statements ..
177*
178 zla_syrcond_x = 0.0d+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( 'ZLA_SYRCOND_X', -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.0d+0
201 IF ( up ) THEN
202 DO i = 1, n
203 tmp = 0.0d+0
204 DO j = 1, i
205 tmp = tmp + cabs1( a( j, i ) * x( j ) )
206 END DO
207 DO j = i+1, n
208 tmp = tmp + cabs1( a( i, j ) * x( j ) )
209 END DO
210 rwork( i ) = tmp
211 anorm = max( anorm, tmp )
212 END DO
213 ELSE
214 DO i = 1, n
215 tmp = 0.0d+0
216 DO j = 1, i
217 tmp = tmp + cabs1( a( i, j ) * x( j ) )
218 END DO
219 DO j = i+1, n
220 tmp = tmp + cabs1( a( j, i ) * x( j ) )
221 END DO
222 rwork( i ) = tmp
223 anorm = max( anorm, tmp )
224 END DO
225 END IF
226*
227* Quick return if possible.
228*
229 IF( n.EQ.0 ) THEN
230 zla_syrcond_x = 1.0d+0
231 RETURN
232 ELSE IF( anorm .EQ. 0.0d+0 ) THEN
233 RETURN
234 END IF
235*
236* Estimate the norm of inv(op(A)).
237*
238 ainvnm = 0.0d+0
239*
240 kase = 0
241 10 CONTINUE
242 CALL zlacn2( n, work( n+1 ), work, ainvnm, kase, isave )
243 IF( kase.NE.0 ) THEN
244 IF( kase.EQ.2 ) THEN
245*
246* Multiply by R.
247*
248 DO i = 1, n
249 work( i ) = work( i ) * rwork( i )
250 END DO
251*
252 IF ( up ) THEN
253 CALL zsytrs( 'U', n, 1, af, ldaf, ipiv,
254 \$ work, n, info )
255 ELSE
256 CALL zsytrs( 'L', n, 1, af, ldaf, ipiv,
257 \$ work, n, info )
258 ENDIF
259*
260* Multiply by inv(X).
261*
262 DO i = 1, n
263 work( i ) = work( i ) / x( i )
264 END DO
265 ELSE
266*
267* Multiply by inv(X**T).
268*
269 DO i = 1, n
270 work( i ) = work( i ) / x( i )
271 END DO
272*
273 IF ( up ) THEN
274 CALL zsytrs( 'U', n, 1, af, ldaf, ipiv,
275 \$ work, n, info )
276 ELSE
277 CALL zsytrs( 'L', n, 1, af, ldaf, ipiv,
278 \$ work, n, info )
279 END IF
280*
281* Multiply by R.
282*
283 DO i = 1, n
284 work( i ) = work( i ) * rwork( i )
285 END DO
286 END IF
287 GO TO 10
288 END IF
289*
290* Compute the estimate of the reciprocal condition number.
291*
292 IF( ainvnm .NE. 0.0d+0 )
293 \$ zla_syrcond_x = 1.0d+0 / ainvnm
294*
295 RETURN
296*
297* End of ZLA_SYRCOND_X
298*
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine zsytrs(uplo, n, nrhs, a, lda, ipiv, b, ldb, info)
ZSYTRS
Definition zsytrs.f:120
double precision function zla_syrcond_x(uplo, n, a, lda, af, ldaf, ipiv, x, info, work, rwork)
ZLA_SYRCOND_X computes the infinity norm condition number of op(A)*diag(x) for symmetric indefinite m...
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
Here is the call graph for this function:
Here is the caller graph for this function: