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