1*> \brief \b ZTRCON 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8*> \htmlonly 9*> Download ZTRCON + dependencies 10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ztrcon.f"> 11*> [TGZ]</a> 12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ztrcon.f"> 13*> [ZIP]</a> 14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ztrcon.f"> 15*> [TXT]</a> 16*> \endhtmlonly 17* 18* Definition: 19* =========== 20* 21* SUBROUTINE ZTRCON( NORM, UPLO, DIAG, N, A, LDA, RCOND, WORK, 22* RWORK, INFO ) 23* 24* .. Scalar Arguments .. 25* CHARACTER DIAG, NORM, UPLO 26* INTEGER INFO, LDA, N 27* DOUBLE PRECISION RCOND 28* .. 29* .. Array Arguments .. 30* DOUBLE PRECISION RWORK( * ) 31* COMPLEX*16 A( LDA, * ), WORK( * ) 32* .. 33* 34* 35*> \par Purpose: 36* ============= 37*> 38*> \verbatim 39*> 40*> ZTRCON estimates the reciprocal of the condition number of a 41*> triangular matrix A, in either the 1-norm or the infinity-norm. 42*> 43*> The norm of A is computed and an estimate is obtained for 44*> norm(inv(A)), then the reciprocal of the condition number is 45*> computed as 46*> RCOND = 1 / ( norm(A) * norm(inv(A)) ). 47*> \endverbatim 48* 49* Arguments: 50* ========== 51* 52*> \param[in] NORM 53*> \verbatim 54*> NORM is CHARACTER*1 55*> Specifies whether the 1-norm condition number or the 56*> infinity-norm condition number is required: 57*> = '1' or 'O': 1-norm; 58*> = 'I': Infinity-norm. 59*> \endverbatim 60*> 61*> \param[in] UPLO 62*> \verbatim 63*> UPLO is CHARACTER*1 64*> = 'U': A is upper triangular; 65*> = 'L': A is lower triangular. 66*> \endverbatim 67*> 68*> \param[in] DIAG 69*> \verbatim 70*> DIAG is CHARACTER*1 71*> = 'N': A is non-unit triangular; 72*> = 'U': A is unit triangular. 73*> \endverbatim 74*> 75*> \param[in] N 76*> \verbatim 77*> N is INTEGER 78*> The order of the matrix A. N >= 0. 79*> \endverbatim 80*> 81*> \param[in] A 82*> \verbatim 83*> A is COMPLEX*16 array, dimension (LDA,N) 84*> The triangular matrix A. If UPLO = 'U', the leading N-by-N 85*> upper triangular part of the array A contains the upper 86*> triangular matrix, and the strictly lower triangular part of 87*> A is not referenced. If UPLO = 'L', the leading N-by-N lower 88*> triangular part of the array A contains the lower triangular 89*> matrix, and the strictly upper triangular part of A is not 90*> referenced. If DIAG = 'U', the diagonal elements of A are 91*> also not referenced and are assumed to be 1. 92*> \endverbatim 93*> 94*> \param[in] LDA 95*> \verbatim 96*> LDA is INTEGER 97*> The leading dimension of the array A. LDA >= max(1,N). 98*> \endverbatim 99*> 100*> \param[out] RCOND 101*> \verbatim 102*> RCOND is DOUBLE PRECISION 103*> The reciprocal of the condition number of the matrix A, 104*> computed as RCOND = 1/(norm(A) * norm(inv(A))). 105*> \endverbatim 106*> 107*> \param[out] WORK 108*> \verbatim 109*> WORK is COMPLEX*16 array, dimension (2*N) 110*> \endverbatim 111*> 112*> \param[out] RWORK 113*> \verbatim 114*> RWORK is DOUBLE PRECISION array, dimension (N) 115*> \endverbatim 116*> 117*> \param[out] INFO 118*> \verbatim 119*> INFO is INTEGER 120*> = 0: successful exit 121*> < 0: if INFO = -i, the i-th argument had an illegal value 122*> \endverbatim 123* 124* Authors: 125* ======== 126* 127*> \author Univ. of Tennessee 128*> \author Univ. of California Berkeley 129*> \author Univ. of Colorado Denver 130*> \author NAG Ltd. 131* 132*> \ingroup complex16OTHERcomputational 133* 134* ===================================================================== 135 SUBROUTINE ZTRCON( NORM, UPLO, DIAG, N, A, LDA, RCOND, WORK, 136 $ RWORK, INFO ) 137* 138* -- LAPACK computational routine -- 139* -- LAPACK is a software package provided by Univ. of Tennessee, -- 140* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 141* 142* .. Scalar Arguments .. 143 CHARACTER DIAG, NORM, UPLO 144 INTEGER INFO, LDA, N 145 DOUBLE PRECISION RCOND 146* .. 147* .. Array Arguments .. 148 DOUBLE PRECISION RWORK( * ) 149 COMPLEX*16 A( LDA, * ), WORK( * ) 150* .. 151* 152* ===================================================================== 153* 154* .. Parameters .. 155 DOUBLE PRECISION ONE, ZERO 156 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) 157* .. 158* .. Local Scalars .. 159 LOGICAL NOUNIT, ONENRM, UPPER 160 CHARACTER NORMIN 161 INTEGER IX, KASE, KASE1 162 DOUBLE PRECISION AINVNM, ANORM, SCALE, SMLNUM, XNORM 163 COMPLEX*16 ZDUM 164* .. 165* .. Local Arrays .. 166 INTEGER ISAVE( 3 ) 167* .. 168* .. External Functions .. 169 LOGICAL LSAME 170 INTEGER IZAMAX 171 DOUBLE PRECISION DLAMCH, ZLANTR 172 EXTERNAL LSAME, IZAMAX, DLAMCH, ZLANTR 173* .. 174* .. External Subroutines .. 175 EXTERNAL XERBLA, ZDRSCL, ZLACN2, ZLATRS 176* .. 177* .. Intrinsic Functions .. 178 INTRINSIC ABS, DBLE, DIMAG, MAX 179* .. 180* .. Statement Functions .. 181 DOUBLE PRECISION CABS1 182* .. 183* .. Statement Function definitions .. 184 CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) ) 185* .. 186* .. Executable Statements .. 187* 188* Test the input parameters. 189* 190 INFO = 0 191 UPPER = LSAME( UPLO, 'U' ) 192 ONENRM = NORM.EQ.'1' .OR. LSAME( NORM, 'O' ) 193 NOUNIT = LSAME( DIAG, 'N' ) 194* 195 IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM, 'I' ) ) THEN 196 INFO = -1 197 ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN 198 INFO = -2 199 ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN 200 INFO = -3 201 ELSE IF( N.LT.0 ) THEN 202 INFO = -4 203 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN 204 INFO = -6 205 END IF 206 IF( INFO.NE.0 ) THEN 207 CALL XERBLA( 'ZTRCON', -INFO ) 208 RETURN 209 END IF 210* 211* Quick return if possible 212* 213 IF( N.EQ.0 ) THEN 214 RCOND = ONE 215 RETURN 216 END IF 217* 218 RCOND = ZERO 219 SMLNUM = DLAMCH( 'Safe minimum' )*DBLE( MAX( 1, N ) ) 220* 221* Compute the norm of the triangular matrix A. 222* 223 ANORM = ZLANTR( NORM, UPLO, DIAG, N, N, A, LDA, RWORK ) 224* 225* Continue only if ANORM > 0. 226* 227 IF( ANORM.GT.ZERO ) THEN 228* 229* Estimate the norm of the inverse of A. 230* 231 AINVNM = ZERO 232 NORMIN = 'N' 233 IF( ONENRM ) THEN 234 KASE1 = 1 235 ELSE 236 KASE1 = 2 237 END IF 238 KASE = 0 239 10 CONTINUE 240 CALL ZLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE ) 241 IF( KASE.NE.0 ) THEN 242 IF( KASE.EQ.KASE1 ) THEN 243* 244* Multiply by inv(A). 245* 246 CALL ZLATRS( UPLO, 'No transpose', DIAG, NORMIN, N, A, 247 $ LDA, WORK, SCALE, RWORK, INFO ) 248 ELSE 249* 250* Multiply by inv(A**H). 251* 252 CALL ZLATRS( UPLO, 'Conjugate transpose', DIAG, NORMIN, 253 $ N, A, LDA, WORK, SCALE, RWORK, INFO ) 254 END IF 255 NORMIN = 'Y' 256* 257* Multiply by 1/SCALE if doing so will not cause overflow. 258* 259 IF( SCALE.NE.ONE ) THEN 260 IX = IZAMAX( N, WORK, 1 ) 261 XNORM = CABS1( WORK( IX ) ) 262 IF( SCALE.LT.XNORM*SMLNUM .OR. SCALE.EQ.ZERO ) 263 $ GO TO 20 264 CALL ZDRSCL( N, SCALE, WORK, 1 ) 265 END IF 266 GO TO 10 267 END IF 268* 269* Compute the estimate of the reciprocal condition number. 270* 271 IF( AINVNM.NE.ZERO ) 272 $ RCOND = ( ONE / ANORM ) / AINVNM 273 END IF 274* 275 20 CONTINUE 276 RETURN 277* 278* End of ZTRCON 279* 280 END 281