1*> \brief \b CLA_HERCOND_X computes the infinity norm condition number of op(A)*diag(x) for Hermitian indefinite matrices. 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8*> \htmlonly 9*> Download CLA_HERCOND_X + dependencies 10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cla_hercond_x.f"> 11*> [TGZ]</a> 12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cla_hercond_x.f"> 13*> [ZIP]</a> 14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cla_hercond_x.f"> 15*> [TXT]</a> 16*> \endhtmlonly 17* 18* Definition: 19* =========== 20* 21* REAL FUNCTION CLA_HERCOND_X( UPLO, N, A, LDA, AF, LDAF, IPIV, X, 22* INFO, WORK, RWORK ) 23* 24* .. Scalar Arguments .. 25* CHARACTER UPLO 26* INTEGER N, LDA, LDAF, INFO 27* .. 28* .. Array Arguments .. 29* INTEGER IPIV( * ) 30* COMPLEX A( LDA, * ), AF( LDAF, * ), WORK( * ), X( * ) 31* REAL RWORK( * ) 32* .. 33* 34* 35*> \par Purpose: 36* ============= 37*> 38*> \verbatim 39*> 40*> CLA_HERCOND_X computes the infinity norm condition number of 41*> op(A) * diag(X) where X is a COMPLEX vector. 42*> \endverbatim 43* 44* Arguments: 45* ========== 46* 47*> \param[in] UPLO 48*> \verbatim 49*> UPLO is CHARACTER*1 50*> = 'U': Upper triangle of A is stored; 51*> = 'L': Lower triangle of A is stored. 52*> \endverbatim 53*> 54*> \param[in] N 55*> \verbatim 56*> N is INTEGER 57*> The number of linear equations, i.e., the order of the 58*> matrix A. N >= 0. 59*> \endverbatim 60*> 61*> \param[in] A 62*> \verbatim 63*> A is COMPLEX array, dimension (LDA,N) 64*> On entry, the N-by-N matrix A. 65*> \endverbatim 66*> 67*> \param[in] LDA 68*> \verbatim 69*> LDA is INTEGER 70*> The leading dimension of the array A. LDA >= max(1,N). 71*> \endverbatim 72*> 73*> \param[in] AF 74*> \verbatim 75*> AF is COMPLEX array, dimension (LDAF,N) 76*> The block diagonal matrix D and the multipliers used to 77*> obtain the factor U or L as computed by CHETRF. 78*> \endverbatim 79*> 80*> \param[in] LDAF 81*> \verbatim 82*> LDAF is INTEGER 83*> The leading dimension of the array AF. LDAF >= max(1,N). 84*> \endverbatim 85*> 86*> \param[in] IPIV 87*> \verbatim 88*> IPIV is INTEGER array, dimension (N) 89*> Details of the interchanges and the block structure of D 90*> as determined by CHETRF. 91*> \endverbatim 92*> 93*> \param[in] X 94*> \verbatim 95*> X is COMPLEX array, dimension (N) 96*> The vector X in the formula op(A) * diag(X). 97*> \endverbatim 98*> 99*> \param[out] INFO 100*> \verbatim 101*> INFO is INTEGER 102*> = 0: Successful exit. 103*> i > 0: The ith argument is invalid. 104*> \endverbatim 105*> 106*> \param[out] WORK 107*> \verbatim 108*> WORK is COMPLEX array, dimension (2*N). 109*> Workspace. 110*> \endverbatim 111*> 112*> \param[out] RWORK 113*> \verbatim 114*> RWORK is REAL array, dimension (N). 115*> Workspace. 116*> \endverbatim 117* 118* Authors: 119* ======== 120* 121*> \author Univ. of Tennessee 122*> \author Univ. of California Berkeley 123*> \author Univ. of Colorado Denver 124*> \author NAG Ltd. 125* 126*> \ingroup complexHEcomputational 127* 128* ===================================================================== 129 REAL FUNCTION CLA_HERCOND_X( UPLO, N, A, LDA, AF, LDAF, IPIV, X, 130 $ INFO, WORK, RWORK ) 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, I, J 150 REAL AINVNM, ANORM, TMP 151 LOGICAL UP, UPPER 152 COMPLEX ZDUM 153* .. 154* .. Local Arrays .. 155 INTEGER ISAVE( 3 ) 156* .. 157* .. External Functions .. 158 LOGICAL LSAME 159 EXTERNAL LSAME 160* .. 161* .. External Subroutines .. 162 EXTERNAL CLACN2, CHETRS, XERBLA 163* .. 164* .. Intrinsic Functions .. 165 INTRINSIC ABS, MAX 166* .. 167* .. Statement Functions .. 168 REAL CABS1 169* .. 170* .. Statement Function Definitions .. 171 CABS1( ZDUM ) = ABS( REAL( ZDUM ) ) + ABS( AIMAG( ZDUM ) ) 172* .. 173* .. Executable Statements .. 174* 175 CLA_HERCOND_X = 0.0E+0 176* 177 INFO = 0 178 UPPER = LSAME( UPLO, 'U' ) 179 IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN 180 INFO = -1 181 ELSE IF ( N.LT.0 ) THEN 182 INFO = -2 183 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN 184 INFO = -4 185 ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN 186 INFO = -6 187 END IF 188 IF( INFO.NE.0 ) THEN 189 CALL XERBLA( 'CLA_HERCOND_X', -INFO ) 190 RETURN 191 END IF 192 UP = .FALSE. 193 IF ( LSAME( UPLO, 'U' ) ) UP = .TRUE. 194* 195* Compute norm of op(A)*op2(C). 196* 197 ANORM = 0.0 198 IF ( UP ) THEN 199 DO I = 1, N 200 TMP = 0.0E+0 201 DO J = 1, I 202 TMP = TMP + CABS1( A( J, I ) * X( J ) ) 203 END DO 204 DO J = I+1, N 205 TMP = TMP + CABS1( A( I, J ) * X( J ) ) 206 END DO 207 RWORK( I ) = TMP 208 ANORM = MAX( ANORM, TMP ) 209 END DO 210 ELSE 211 DO I = 1, N 212 TMP = 0.0E+0 213 DO J = 1, I 214 TMP = TMP + CABS1( A( I, J ) * X( J ) ) 215 END DO 216 DO J = I+1, N 217 TMP = TMP + CABS1( A( J, I ) * X( J ) ) 218 END DO 219 RWORK( I ) = TMP 220 ANORM = MAX( ANORM, TMP ) 221 END DO 222 END IF 223* 224* Quick return if possible. 225* 226 IF( N.EQ.0 ) THEN 227 CLA_HERCOND_X = 1.0E+0 228 RETURN 229 ELSE IF( ANORM .EQ. 0.0E+0 ) THEN 230 RETURN 231 END IF 232* 233* Estimate the norm of inv(op(A)). 234* 235 AINVNM = 0.0E+0 236* 237 KASE = 0 238 10 CONTINUE 239 CALL CLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE ) 240 IF( KASE.NE.0 ) THEN 241 IF( KASE.EQ.2 ) THEN 242* 243* Multiply by R. 244* 245 DO I = 1, N 246 WORK( I ) = WORK( I ) * RWORK( I ) 247 END DO 248* 249 IF ( UP ) THEN 250 CALL CHETRS( 'U', N, 1, AF, LDAF, IPIV, 251 $ WORK, N, INFO ) 252 ELSE 253 CALL CHETRS( 'L', N, 1, AF, LDAF, IPIV, 254 $ WORK, N, INFO ) 255 ENDIF 256* 257* Multiply by inv(X). 258* 259 DO I = 1, N 260 WORK( I ) = WORK( I ) / X( I ) 261 END DO 262 ELSE 263* 264* Multiply by inv(X**H). 265* 266 DO I = 1, N 267 WORK( I ) = WORK( I ) / X( I ) 268 END DO 269* 270 IF ( UP ) THEN 271 CALL CHETRS( 'U', N, 1, AF, LDAF, IPIV, 272 $ WORK, N, INFO ) 273 ELSE 274 CALL CHETRS( 'L', N, 1, AF, LDAF, IPIV, 275 $ WORK, N, INFO ) 276 END IF 277* 278* Multiply by R. 279* 280 DO I = 1, N 281 WORK( I ) = WORK( I ) * RWORK( I ) 282 END DO 283 END IF 284 GO TO 10 285 END IF 286* 287* Compute the estimate of the reciprocal condition number. 288* 289 IF( AINVNM .NE. 0.0E+0 ) 290 $ CLA_HERCOND_X = 1.0E+0 / AINVNM 291* 292 RETURN 293* 294* End of CLA_HERCOND_X 295* 296 END 297