LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
real function cla_porcond_x ( character  UPLO,
integer  N,
complex, dimension( lda, * )  A,
integer  LDA,
complex, dimension( ldaf, * )  AF,
integer  LDAF,
complex, dimension( * )  X,
integer  INFO,
complex, dimension( * )  WORK,
real, dimension( * )  RWORK 
)

CLA_PORCOND_X computes the infinity norm condition number of op(A)*diag(x) for Hermitian positive-definite matrices.

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

Purpose:
    CLA_PORCOND_X Computes the infinity norm condition number of
    op(A) * diag(X) where X is a COMPLEX 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 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 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 CPOTRF.
[in]LDAF
          LDAF is INTEGER
     The leading dimension of the array AF.  LDAF >= max(1,N).
[in]X
          X is COMPLEX 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 array, dimension (2*N).
     Workspace.
[in]RWORK
          RWORK is REAL array, dimension (N).
     Workspace.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
September 2012

Definition at line 125 of file cla_porcond_x.f.

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

Here is the call graph for this function:

Here is the caller graph for this function: