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