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