LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ cla_syrcond_x()

real function cla_syrcond_x ( character  UPLO,
integer  N,
complex, dimension( lda, * )  A,
integer  LDA,
complex, dimension( ldaf, * )  AF,
integer  LDAF,
integer, dimension( * )  IPIV,
complex, dimension( * )  X,
integer  INFO,
complex, dimension( * )  WORK,
real, dimension( * )  RWORK 
)

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

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

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

Definition at line 129 of file cla_syrcond_x.f.

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