LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ zla_hercond_c()

double precision function zla_hercond_c ( character uplo,
integer n,
complex*16, dimension( lda, * ) a,
integer lda,
complex*16, dimension( ldaf, * ) af,
integer ldaf,
integer, dimension( * ) ipiv,
double precision, dimension ( * ) c,
logical capply,
integer info,
complex*16, dimension( * ) work,
double precision, dimension( * ) rwork )

ZLA_HERCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for Hermitian indefinite matrices.

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

Purpose:
!>
!>    ZLA_HERCOND_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 block diagonal matrix D and the multipliers used to
!>     obtain the factor U or L as computed by ZHETRF.
!>
[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 CHETRF.
!>
[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.
!>
[out]WORK
!>          WORK is COMPLEX*16 array, dimension (2*N).
!>     Workspace.
!>
[out]RWORK
!>          RWORK is DOUBLE PRECISION array, dimension (N).
!>     Workspace.
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 135 of file zla_hercond_c.f.

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