LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
double precision function zla_hercond_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_HERCOND_X computes the infinity norm condition number of op(A)*diag(x) for Hermitian indefinite matrices.

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

Purpose:
    ZLA_HERCOND_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 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]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.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
September 2012

Definition at line 135 of file zla_hercond_x.f.

135 *
136 * -- LAPACK computational routine (version 3.4.2) --
137 * -- LAPACK is a software package provided by Univ. of Tennessee, --
138 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
139 * September 2012
140 *
141 * .. Scalar Arguments ..
142  CHARACTER uplo
143  INTEGER n, lda, ldaf, info
144 * ..
145 * .. Array Arguments ..
146  INTEGER ipiv( * )
147  COMPLEX*16 a( lda, * ), af( ldaf, * ), work( * ), x( * )
148  DOUBLE PRECISION rwork( * )
149 * ..
150 *
151 * =====================================================================
152 *
153 * .. Local Scalars ..
154  INTEGER kase, i, j
155  DOUBLE PRECISION ainvnm, anorm, tmp
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, zhetrs, xerbla
168 * ..
169 * .. Intrinsic Functions ..
170  INTRINSIC abs, max
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_hercond_x = 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_HERCOND_X', -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  DO j = 1, i
207  tmp = tmp + cabs1( a( j, i ) * x( j ) )
208  END DO
209  DO j = i+1, n
210  tmp = tmp + cabs1( a( i, j ) * x( j ) )
211  END DO
212  rwork( i ) = tmp
213  anorm = max( anorm, tmp )
214  END DO
215  ELSE
216  DO i = 1, n
217  tmp = 0.0d+0
218  DO j = 1, i
219  tmp = tmp + cabs1( a( i, j ) * x( j ) )
220  END DO
221  DO j = i+1, n
222  tmp = tmp + cabs1( a( j, i ) * x( j ) )
223  END DO
224  rwork( i ) = tmp
225  anorm = max( anorm, tmp )
226  END DO
227  END IF
228 *
229 * Quick return if possible.
230 *
231  IF( n.EQ.0 ) THEN
232  zla_hercond_x = 1.0d+0
233  RETURN
234  ELSE IF( anorm .EQ. 0.0d+0 ) THEN
235  RETURN
236  END IF
237 *
238 * Estimate the norm of inv(op(A)).
239 *
240  ainvnm = 0.0d+0
241 *
242  kase = 0
243  10 CONTINUE
244  CALL zlacn2( n, work( n+1 ), work, ainvnm, kase, isave )
245  IF( kase.NE.0 ) THEN
246  IF( kase.EQ.2 ) THEN
247 *
248 * Multiply by R.
249 *
250  DO i = 1, n
251  work( i ) = work( i ) * rwork( i )
252  END DO
253 *
254  IF ( up ) THEN
255  CALL zhetrs( 'U', n, 1, af, ldaf, ipiv,
256  $ work, n, info )
257  ELSE
258  CALL zhetrs( 'L', n, 1, af, ldaf, ipiv,
259  $ work, n, info )
260  ENDIF
261 *
262 * Multiply by inv(X).
263 *
264  DO i = 1, n
265  work( i ) = work( i ) / x( i )
266  END DO
267  ELSE
268 *
269 * Multiply by inv(X**H).
270 *
271  DO i = 1, n
272  work( i ) = work( i ) / x( 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  END IF
282 *
283 * Multiply by R.
284 *
285  DO i = 1, n
286  work( i ) = work( i ) * rwork( i )
287  END DO
288  END IF
289  GO TO 10
290  END IF
291 *
292 * Compute the estimate of the reciprocal condition number.
293 *
294  IF( ainvnm .NE. 0.0d+0 )
295  $ zla_hercond_x = 1.0d+0 / ainvnm
296 *
297  RETURN
298 *
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_hercond_x(UPLO, N, A, LDA, AF, LDAF, IPIV, X, INFO, WORK, RWORK)
ZLA_HERCOND_X computes the infinity norm condition number of op(A)*diag(x) for Hermitian indefinite m...
subroutine zhetrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZHETRS
Definition: zhetrs.f:122
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55

Here is the call graph for this function:

Here is the caller graph for this function: