LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros Modules Pages

◆ cla_hercond_x()

real function cla_hercond_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_HERCOND_X computes the infinity norm condition number of op(A)*diag(x) for Hermitian indefinite matrices.

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

Purpose:
!> !> CLA_HERCOND_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 CHETRF. !>
[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 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 127 of file cla_hercond_x.f.

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