![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b CLA_GBRCOND_C 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download CLA_GBRCOND_C + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cla_gbrcond_c.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cla_gbrcond_c.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cla_gbrcond_c.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * REAL FUNCTION CLA_GBRCOND_C( TRANS, N, KL, KU, AB, LDAB, AFB, 00022 * LDAFB, IPIV, C, CAPPLY, INFO, WORK, 00023 * RWORK ) 00024 * 00025 * .. Scalar Arguments .. 00026 * CHARACTER TRANS 00027 * LOGICAL CAPPLY 00028 * INTEGER N, KL, KU, KD, KE, LDAB, LDAFB, INFO 00029 * .. 00030 * .. Array Arguments .. 00031 * INTEGER IPIV( * ) 00032 * COMPLEX AB( LDAB, * ), AFB( LDAFB, * ), WORK( * ) 00033 * REAL C( * ), RWORK( * ) 00034 * .. 00035 * 00036 * 00037 *> \par Purpose: 00038 * ============= 00039 *> 00040 *> \verbatim 00041 *> 00042 *> CLA_GBRCOND_C Computes the infinity norm condition number of 00043 *> op(A) * inv(diag(C)) where C is a REAL vector. 00044 *> \endverbatim 00045 * 00046 * Arguments: 00047 * ========== 00048 * 00049 *> \param[in] TRANS 00050 *> \verbatim 00051 *> TRANS is CHARACTER*1 00052 *> Specifies the form of the system of equations: 00053 *> = 'N': A * X = B (No transpose) 00054 *> = 'T': A**T * X = B (Transpose) 00055 *> = 'C': A**H * X = B (Conjugate Transpose = Transpose) 00056 *> \endverbatim 00057 *> 00058 *> \param[in] N 00059 *> \verbatim 00060 *> N is INTEGER 00061 *> The number of linear equations, i.e., the order of the 00062 *> matrix A. N >= 0. 00063 *> \endverbatim 00064 *> 00065 *> \param[in] KL 00066 *> \verbatim 00067 *> KL is INTEGER 00068 *> The number of subdiagonals within the band of A. KL >= 0. 00069 *> \endverbatim 00070 *> 00071 *> \param[in] KU 00072 *> \verbatim 00073 *> KU is INTEGER 00074 *> The number of superdiagonals within the band of A. KU >= 0. 00075 *> \endverbatim 00076 *> 00077 *> \param[in] AB 00078 *> \verbatim 00079 *> AB is COMPLEX array, dimension (LDAB,N) 00080 *> On entry, the matrix A in band storage, in rows 1 to KL+KU+1. 00081 *> The j-th column of A is stored in the j-th column of the 00082 *> array AB as follows: 00083 *> AB(KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+kl) 00084 *> \endverbatim 00085 *> 00086 *> \param[in] LDAB 00087 *> \verbatim 00088 *> LDAB is INTEGER 00089 *> The leading dimension of the array AB. LDAB >= KL+KU+1. 00090 *> \endverbatim 00091 *> 00092 *> \param[in] AFB 00093 *> \verbatim 00094 *> AFB is COMPLEX array, dimension (LDAFB,N) 00095 *> Details of the LU factorization of the band matrix A, as 00096 *> computed by CGBTRF. U is stored as an upper triangular 00097 *> band matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, 00098 *> and the multipliers used during the factorization are stored 00099 *> in rows KL+KU+2 to 2*KL+KU+1. 00100 *> \endverbatim 00101 *> 00102 *> \param[in] LDAFB 00103 *> \verbatim 00104 *> LDAFB is INTEGER 00105 *> The leading dimension of the array AFB. LDAFB >= 2*KL+KU+1. 00106 *> \endverbatim 00107 *> 00108 *> \param[in] IPIV 00109 *> \verbatim 00110 *> IPIV is INTEGER array, dimension (N) 00111 *> The pivot indices from the factorization A = P*L*U 00112 *> as computed by CGBTRF; row i of the matrix was interchanged 00113 *> with row IPIV(i). 00114 *> \endverbatim 00115 *> 00116 *> \param[in] C 00117 *> \verbatim 00118 *> C is REAL array, dimension (N) 00119 *> The vector C in the formula op(A) * inv(diag(C)). 00120 *> \endverbatim 00121 *> 00122 *> \param[in] CAPPLY 00123 *> \verbatim 00124 *> CAPPLY is LOGICAL 00125 *> If .TRUE. then access the vector C in the formula above. 00126 *> \endverbatim 00127 *> 00128 *> \param[out] INFO 00129 *> \verbatim 00130 *> INFO is INTEGER 00131 *> = 0: Successful exit. 00132 *> i > 0: The ith argument is invalid. 00133 *> \endverbatim 00134 *> 00135 *> \param[in] WORK 00136 *> \verbatim 00137 *> WORK is COMPLEX array, dimension (2*N). 00138 *> Workspace. 00139 *> \endverbatim 00140 *> 00141 *> \param[in] RWORK 00142 *> \verbatim 00143 *> RWORK is REAL array, dimension (N). 00144 *> Workspace. 00145 *> \endverbatim 00146 * 00147 * Authors: 00148 * ======== 00149 * 00150 *> \author Univ. of Tennessee 00151 *> \author Univ. of California Berkeley 00152 *> \author Univ. of Colorado Denver 00153 *> \author NAG Ltd. 00154 * 00155 *> \date November 2011 00156 * 00157 *> \ingroup complexGBcomputational 00158 * 00159 * ===================================================================== 00160 REAL FUNCTION CLA_GBRCOND_C( TRANS, N, KL, KU, AB, LDAB, AFB, 00161 $ LDAFB, IPIV, C, CAPPLY, INFO, WORK, 00162 $ RWORK ) 00163 * 00164 * -- LAPACK computational routine (version 3.4.0) -- 00165 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00166 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00167 * November 2011 00168 * 00169 * .. Scalar Arguments .. 00170 CHARACTER TRANS 00171 LOGICAL CAPPLY 00172 INTEGER N, KL, KU, KD, KE, LDAB, LDAFB, INFO 00173 * .. 00174 * .. Array Arguments .. 00175 INTEGER IPIV( * ) 00176 COMPLEX AB( LDAB, * ), AFB( LDAFB, * ), WORK( * ) 00177 REAL C( * ), RWORK( * ) 00178 * .. 00179 * 00180 * ===================================================================== 00181 * 00182 * .. Local Scalars .. 00183 LOGICAL NOTRANS 00184 INTEGER KASE, I, J 00185 REAL AINVNM, ANORM, TMP 00186 COMPLEX ZDUM 00187 * .. 00188 * .. Local Arrays .. 00189 INTEGER ISAVE( 3 ) 00190 * .. 00191 * .. External Functions .. 00192 LOGICAL LSAME 00193 EXTERNAL LSAME 00194 * .. 00195 * .. External Subroutines .. 00196 EXTERNAL CLACN2, CGBTRS, XERBLA 00197 * .. 00198 * .. Intrinsic Functions .. 00199 INTRINSIC ABS, MAX 00200 * .. 00201 * .. Statement Functions .. 00202 REAL CABS1 00203 * .. 00204 * .. Statement Function Definitions .. 00205 CABS1( ZDUM ) = ABS( REAL( ZDUM ) ) + ABS( AIMAG( ZDUM ) ) 00206 * .. 00207 * .. Executable Statements .. 00208 CLA_GBRCOND_C = 0.0E+0 00209 * 00210 INFO = 0 00211 NOTRANS = LSAME( TRANS, 'N' ) 00212 IF ( .NOT. NOTRANS .AND. .NOT. LSAME( TRANS, 'T' ) .AND. .NOT. 00213 $ LSAME( TRANS, 'C' ) ) THEN 00214 INFO = -1 00215 ELSE IF( N.LT.0 ) THEN 00216 INFO = -2 00217 ELSE IF( KL.LT.0 .OR. KL.GT.N-1 ) THEN 00218 INFO = -3 00219 ELSE IF( KU.LT.0 .OR. KU.GT.N-1 ) THEN 00220 INFO = -4 00221 ELSE IF( LDAB.LT.KL+KU+1 ) THEN 00222 INFO = -6 00223 ELSE IF( LDAFB.LT.2*KL+KU+1 ) THEN 00224 INFO = -8 00225 END IF 00226 IF( INFO.NE.0 ) THEN 00227 CALL XERBLA( 'CLA_GBRCOND_C', -INFO ) 00228 RETURN 00229 END IF 00230 * 00231 * Compute norm of op(A)*op2(C). 00232 * 00233 ANORM = 0.0E+0 00234 KD = KU + 1 00235 KE = KL + 1 00236 IF ( NOTRANS ) THEN 00237 DO I = 1, N 00238 TMP = 0.0E+0 00239 IF ( CAPPLY ) THEN 00240 DO J = MAX( I-KL, 1 ), MIN( I+KU, N ) 00241 TMP = TMP + CABS1( AB( KD+I-J, J ) ) / C( J ) 00242 END DO 00243 ELSE 00244 DO J = MAX( I-KL, 1 ), MIN( I+KU, N ) 00245 TMP = TMP + CABS1( AB( KD+I-J, J ) ) 00246 END DO 00247 END IF 00248 RWORK( I ) = TMP 00249 ANORM = MAX( ANORM, TMP ) 00250 END DO 00251 ELSE 00252 DO I = 1, N 00253 TMP = 0.0E+0 00254 IF ( CAPPLY ) THEN 00255 DO J = MAX( I-KL, 1 ), MIN( I+KU, N ) 00256 TMP = TMP + CABS1( AB( KE-I+J, I ) ) / C( J ) 00257 END DO 00258 ELSE 00259 DO J = MAX( I-KL, 1 ), MIN( I+KU, N ) 00260 TMP = TMP + CABS1( AB( KE-I+J, I ) ) 00261 END DO 00262 END IF 00263 RWORK( I ) = TMP 00264 ANORM = MAX( ANORM, TMP ) 00265 END DO 00266 END IF 00267 * 00268 * Quick return if possible. 00269 * 00270 IF( N.EQ.0 ) THEN 00271 CLA_GBRCOND_C = 1.0E+0 00272 RETURN 00273 ELSE IF( ANORM .EQ. 0.0E+0 ) THEN 00274 RETURN 00275 END IF 00276 * 00277 * Estimate the norm of inv(op(A)). 00278 * 00279 AINVNM = 0.0E+0 00280 * 00281 KASE = 0 00282 10 CONTINUE 00283 CALL CLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE ) 00284 IF( KASE.NE.0 ) THEN 00285 IF( KASE.EQ.2 ) THEN 00286 * 00287 * Multiply by R. 00288 * 00289 DO I = 1, N 00290 WORK( I ) = WORK( I ) * RWORK( I ) 00291 END DO 00292 * 00293 IF ( NOTRANS ) THEN 00294 CALL CGBTRS( 'No transpose', N, KL, KU, 1, AFB, LDAFB, 00295 $ IPIV, WORK, N, INFO ) 00296 ELSE 00297 CALL CGBTRS( 'Conjugate transpose', N, KL, KU, 1, AFB, 00298 $ LDAFB, IPIV, WORK, N, INFO ) 00299 ENDIF 00300 * 00301 * Multiply by inv(C). 00302 * 00303 IF ( CAPPLY ) THEN 00304 DO I = 1, N 00305 WORK( I ) = WORK( I ) * C( I ) 00306 END DO 00307 END IF 00308 ELSE 00309 * 00310 * Multiply by inv(C**H). 00311 * 00312 IF ( CAPPLY ) THEN 00313 DO I = 1, N 00314 WORK( I ) = WORK( I ) * C( I ) 00315 END DO 00316 END IF 00317 * 00318 IF ( NOTRANS ) THEN 00319 CALL CGBTRS( 'Conjugate transpose', N, KL, KU, 1, AFB, 00320 $ LDAFB, IPIV, WORK, N, INFO ) 00321 ELSE 00322 CALL CGBTRS( 'No transpose', N, KL, KU, 1, AFB, LDAFB, 00323 $ IPIV, WORK, N, INFO ) 00324 END IF 00325 * 00326 * Multiply by R. 00327 * 00328 DO I = 1, N 00329 WORK( I ) = WORK( I ) * RWORK( I ) 00330 END DO 00331 END IF 00332 GO TO 10 00333 END IF 00334 * 00335 * Compute the estimate of the reciprocal condition number. 00336 * 00337 IF( AINVNM .NE. 0.0E+0 ) 00338 $ CLA_GBRCOND_C = 1.0E+0 / AINVNM 00339 * 00340 RETURN 00341 * 00342 END