1*> \brief \b CGBCON 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8*> \htmlonly 9*> Download CGBCON + dependencies 10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgbcon.f"> 11*> [TGZ]</a> 12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cgbcon.f"> 13*> [ZIP]</a> 14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgbcon.f"> 15*> [TXT]</a> 16*> \endhtmlonly 17* 18* Definition: 19* =========== 20* 21* SUBROUTINE CGBCON( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, 22* WORK, RWORK, INFO ) 23* 24* .. Scalar Arguments .. 25* CHARACTER NORM 26* INTEGER INFO, KL, KU, LDAB, N 27* REAL ANORM, RCOND 28* .. 29* .. Array Arguments .. 30* INTEGER IPIV( * ) 31* REAL RWORK( * ) 32* COMPLEX AB( LDAB, * ), WORK( * ) 33* .. 34* 35* 36*> \par Purpose: 37* ============= 38*> 39*> \verbatim 40*> 41*> CGBCON estimates the reciprocal of the condition number of a complex 42*> general band matrix A, in either the 1-norm or the infinity-norm, 43*> using the LU factorization computed by CGBTRF. 44*> 45*> An estimate is obtained for norm(inv(A)), and the reciprocal of the 46*> condition number is computed as 47*> RCOND = 1 / ( norm(A) * norm(inv(A)) ). 48*> \endverbatim 49* 50* Arguments: 51* ========== 52* 53*> \param[in] NORM 54*> \verbatim 55*> NORM is CHARACTER*1 56*> Specifies whether the 1-norm condition number or the 57*> infinity-norm condition number is required: 58*> = '1' or 'O': 1-norm; 59*> = 'I': Infinity-norm. 60*> \endverbatim 61*> 62*> \param[in] N 63*> \verbatim 64*> N is INTEGER 65*> The order of the matrix A. N >= 0. 66*> \endverbatim 67*> 68*> \param[in] KL 69*> \verbatim 70*> KL is INTEGER 71*> The number of subdiagonals within the band of A. KL >= 0. 72*> \endverbatim 73*> 74*> \param[in] KU 75*> \verbatim 76*> KU is INTEGER 77*> The number of superdiagonals within the band of A. KU >= 0. 78*> \endverbatim 79*> 80*> \param[in] AB 81*> \verbatim 82*> AB is COMPLEX array, dimension (LDAB,N) 83*> Details of the LU factorization of the band matrix A, as 84*> computed by CGBTRF. U is stored as an upper triangular band 85*> matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, and 86*> the multipliers used during the factorization are stored in 87*> rows KL+KU+2 to 2*KL+KU+1. 88*> \endverbatim 89*> 90*> \param[in] LDAB 91*> \verbatim 92*> LDAB is INTEGER 93*> The leading dimension of the array AB. LDAB >= 2*KL+KU+1. 94*> \endverbatim 95*> 96*> \param[in] IPIV 97*> \verbatim 98*> IPIV is INTEGER array, dimension (N) 99*> The pivot indices; for 1 <= i <= N, row i of the matrix was 100*> interchanged with row IPIV(i). 101*> \endverbatim 102*> 103*> \param[in] ANORM 104*> \verbatim 105*> ANORM is REAL 106*> If NORM = '1' or 'O', the 1-norm of the original matrix A. 107*> If NORM = 'I', the infinity-norm of the original matrix A. 108*> \endverbatim 109*> 110*> \param[out] RCOND 111*> \verbatim 112*> RCOND is REAL 113*> The reciprocal of the condition number of the matrix A, 114*> computed as RCOND = 1/(norm(A) * norm(inv(A))). 115*> \endverbatim 116*> 117*> \param[out] WORK 118*> \verbatim 119*> WORK is COMPLEX array, dimension (2*N) 120*> \endverbatim 121*> 122*> \param[out] RWORK 123*> \verbatim 124*> RWORK is REAL array, dimension (N) 125*> \endverbatim 126*> 127*> \param[out] INFO 128*> \verbatim 129*> INFO is INTEGER 130*> = 0: successful exit 131*> < 0: if INFO = -i, the i-th argument had an illegal value 132*> \endverbatim 133* 134* Authors: 135* ======== 136* 137*> \author Univ. of Tennessee 138*> \author Univ. of California Berkeley 139*> \author Univ. of Colorado Denver 140*> \author NAG Ltd. 141* 142*> \ingroup complexGBcomputational 143* 144* ===================================================================== 145 SUBROUTINE CGBCON( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, 146 $ WORK, RWORK, INFO ) 147* 148* -- LAPACK computational routine -- 149* -- LAPACK is a software package provided by Univ. of Tennessee, -- 150* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 151* 152* .. Scalar Arguments .. 153 CHARACTER NORM 154 INTEGER INFO, KL, KU, LDAB, N 155 REAL ANORM, RCOND 156* .. 157* .. Array Arguments .. 158 INTEGER IPIV( * ) 159 REAL RWORK( * ) 160 COMPLEX AB( LDAB, * ), WORK( * ) 161* .. 162* 163* ===================================================================== 164* 165* .. Parameters .. 166 REAL ONE, ZERO 167 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 168* .. 169* .. Local Scalars .. 170 LOGICAL LNOTI, ONENRM 171 CHARACTER NORMIN 172 INTEGER IX, J, JP, KASE, KASE1, KD, LM 173 REAL AINVNM, SCALE, SMLNUM 174 COMPLEX T, ZDUM 175* .. 176* .. Local Arrays .. 177 INTEGER ISAVE( 3 ) 178* .. 179* .. External Functions .. 180 LOGICAL LSAME 181 INTEGER ICAMAX 182 REAL SLAMCH 183 COMPLEX CDOTC 184 EXTERNAL LSAME, ICAMAX, SLAMCH, CDOTC 185* .. 186* .. External Subroutines .. 187 EXTERNAL CAXPY, CLACN2, CLATBS, CSRSCL, XERBLA 188* .. 189* .. Intrinsic Functions .. 190 INTRINSIC ABS, AIMAG, MIN, REAL 191* .. 192* .. Statement Functions .. 193 REAL CABS1 194* .. 195* .. Statement Function definitions .. 196 CABS1( ZDUM ) = ABS( REAL( ZDUM ) ) + ABS( AIMAG( ZDUM ) ) 197* .. 198* .. Executable Statements .. 199* 200* Test the input parameters. 201* 202 INFO = 0 203 ONENRM = NORM.EQ.'1' .OR. LSAME( NORM, 'O' ) 204 IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM, 'I' ) ) THEN 205 INFO = -1 206 ELSE IF( N.LT.0 ) THEN 207 INFO = -2 208 ELSE IF( KL.LT.0 ) THEN 209 INFO = -3 210 ELSE IF( KU.LT.0 ) THEN 211 INFO = -4 212 ELSE IF( LDAB.LT.2*KL+KU+1 ) THEN 213 INFO = -6 214 ELSE IF( ANORM.LT.ZERO ) THEN 215 INFO = -8 216 END IF 217 IF( INFO.NE.0 ) THEN 218 CALL XERBLA( 'CGBCON', -INFO ) 219 RETURN 220 END IF 221* 222* Quick return if possible 223* 224 RCOND = ZERO 225 IF( N.EQ.0 ) THEN 226 RCOND = ONE 227 RETURN 228 ELSE IF( ANORM.EQ.ZERO ) THEN 229 RETURN 230 END IF 231* 232 SMLNUM = SLAMCH( 'Safe minimum' ) 233* 234* Estimate the norm of inv(A). 235* 236 AINVNM = ZERO 237 NORMIN = 'N' 238 IF( ONENRM ) THEN 239 KASE1 = 1 240 ELSE 241 KASE1 = 2 242 END IF 243 KD = KL + KU + 1 244 LNOTI = KL.GT.0 245 KASE = 0 246 10 CONTINUE 247 CALL CLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE ) 248 IF( KASE.NE.0 ) THEN 249 IF( KASE.EQ.KASE1 ) THEN 250* 251* Multiply by inv(L). 252* 253 IF( LNOTI ) THEN 254 DO 20 J = 1, N - 1 255 LM = MIN( KL, N-J ) 256 JP = IPIV( J ) 257 T = WORK( JP ) 258 IF( JP.NE.J ) THEN 259 WORK( JP ) = WORK( J ) 260 WORK( J ) = T 261 END IF 262 CALL CAXPY( LM, -T, AB( KD+1, J ), 1, WORK( J+1 ), 1 ) 263 20 CONTINUE 264 END IF 265* 266* Multiply by inv(U). 267* 268 CALL CLATBS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N, 269 $ KL+KU, AB, LDAB, WORK, SCALE, RWORK, INFO ) 270 ELSE 271* 272* Multiply by inv(U**H). 273* 274 CALL CLATBS( 'Upper', 'Conjugate transpose', 'Non-unit', 275 $ NORMIN, N, KL+KU, AB, LDAB, WORK, SCALE, RWORK, 276 $ INFO ) 277* 278* Multiply by inv(L**H). 279* 280 IF( LNOTI ) THEN 281 DO 30 J = N - 1, 1, -1 282 LM = MIN( KL, N-J ) 283 WORK( J ) = WORK( J ) - CDOTC( LM, AB( KD+1, J ), 1, 284 $ WORK( J+1 ), 1 ) 285 JP = IPIV( J ) 286 IF( JP.NE.J ) THEN 287 T = WORK( JP ) 288 WORK( JP ) = WORK( J ) 289 WORK( J ) = T 290 END IF 291 30 CONTINUE 292 END IF 293 END IF 294* 295* Divide X by 1/SCALE if doing so will not cause overflow. 296* 297 NORMIN = 'Y' 298 IF( SCALE.NE.ONE ) THEN 299 IX = ICAMAX( N, WORK, 1 ) 300 IF( SCALE.LT.CABS1( WORK( IX ) )*SMLNUM .OR. SCALE.EQ.ZERO ) 301 $ GO TO 40 302 CALL CSRSCL( N, SCALE, WORK, 1 ) 303 END IF 304 GO TO 10 305 END IF 306* 307* Compute the estimate of the reciprocal condition number. 308* 309 IF( AINVNM.NE.ZERO ) 310 $ RCOND = ( ONE / AINVNM ) / ANORM 311* 312 40 CONTINUE 313 RETURN 314* 315* End of CGBCON 316* 317 END 318