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.

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

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.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
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: