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