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