![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZGTCON 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download ZGTCON + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgtcon.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgtcon.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgtcon.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE ZGTCON( NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND, 00022 * WORK, INFO ) 00023 * 00024 * .. Scalar Arguments .. 00025 * CHARACTER NORM 00026 * INTEGER INFO, N 00027 * DOUBLE PRECISION ANORM, RCOND 00028 * .. 00029 * .. Array Arguments .. 00030 * INTEGER IPIV( * ) 00031 * COMPLEX*16 D( * ), DL( * ), DU( * ), DU2( * ), WORK( * ) 00032 * .. 00033 * 00034 * 00035 *> \par Purpose: 00036 * ============= 00037 *> 00038 *> \verbatim 00039 *> 00040 *> ZGTCON estimates the reciprocal of the condition number of a complex 00041 *> tridiagonal matrix A using the LU factorization as computed by 00042 *> ZGTTRF. 00043 *> 00044 *> An estimate is obtained for norm(inv(A)), and the reciprocal of the 00045 *> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). 00046 *> \endverbatim 00047 * 00048 * Arguments: 00049 * ========== 00050 * 00051 *> \param[in] NORM 00052 *> \verbatim 00053 *> NORM is CHARACTER*1 00054 *> Specifies whether the 1-norm condition number or the 00055 *> infinity-norm condition number is required: 00056 *> = '1' or 'O': 1-norm; 00057 *> = 'I': Infinity-norm. 00058 *> \endverbatim 00059 *> 00060 *> \param[in] N 00061 *> \verbatim 00062 *> N is INTEGER 00063 *> The order of the matrix A. N >= 0. 00064 *> \endverbatim 00065 *> 00066 *> \param[in] DL 00067 *> \verbatim 00068 *> DL is COMPLEX*16 array, dimension (N-1) 00069 *> The (n-1) multipliers that define the matrix L from the 00070 *> LU factorization of A as computed by ZGTTRF. 00071 *> \endverbatim 00072 *> 00073 *> \param[in] D 00074 *> \verbatim 00075 *> D is COMPLEX*16 array, dimension (N) 00076 *> The n diagonal elements of the upper triangular matrix U from 00077 *> the LU factorization of A. 00078 *> \endverbatim 00079 *> 00080 *> \param[in] DU 00081 *> \verbatim 00082 *> DU is COMPLEX*16 array, dimension (N-1) 00083 *> The (n-1) elements of the first superdiagonal of U. 00084 *> \endverbatim 00085 *> 00086 *> \param[in] DU2 00087 *> \verbatim 00088 *> DU2 is COMPLEX*16 array, dimension (N-2) 00089 *> The (n-2) elements of the second superdiagonal of U. 00090 *> \endverbatim 00091 *> 00092 *> \param[in] IPIV 00093 *> \verbatim 00094 *> IPIV is INTEGER array, dimension (N) 00095 *> The pivot indices; for 1 <= i <= n, row i of the matrix was 00096 *> interchanged with row IPIV(i). IPIV(i) will always be either 00097 *> i or i+1; IPIV(i) = i indicates a row interchange was not 00098 *> required. 00099 *> \endverbatim 00100 *> 00101 *> \param[in] ANORM 00102 *> \verbatim 00103 *> ANORM is DOUBLE PRECISION 00104 *> If NORM = '1' or 'O', the 1-norm of the original matrix A. 00105 *> If NORM = 'I', the infinity-norm of the original matrix A. 00106 *> \endverbatim 00107 *> 00108 *> \param[out] RCOND 00109 *> \verbatim 00110 *> RCOND is DOUBLE PRECISION 00111 *> The reciprocal of the condition number of the matrix A, 00112 *> computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an 00113 *> estimate of the 1-norm of inv(A) computed in this routine. 00114 *> \endverbatim 00115 *> 00116 *> \param[out] WORK 00117 *> \verbatim 00118 *> WORK is COMPLEX*16 array, dimension (2*N) 00119 *> \endverbatim 00120 *> 00121 *> \param[out] INFO 00122 *> \verbatim 00123 *> INFO is INTEGER 00124 *> = 0: successful exit 00125 *> < 0: if INFO = -i, the i-th argument had an illegal value 00126 *> \endverbatim 00127 * 00128 * Authors: 00129 * ======== 00130 * 00131 *> \author Univ. of Tennessee 00132 *> \author Univ. of California Berkeley 00133 *> \author Univ. of Colorado Denver 00134 *> \author NAG Ltd. 00135 * 00136 *> \date November 2011 00137 * 00138 *> \ingroup complex16OTHERcomputational 00139 * 00140 * ===================================================================== 00141 SUBROUTINE ZGTCON( NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND, 00142 $ WORK, INFO ) 00143 * 00144 * -- LAPACK computational routine (version 3.4.0) -- 00145 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00146 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00147 * November 2011 00148 * 00149 * .. Scalar Arguments .. 00150 CHARACTER NORM 00151 INTEGER INFO, N 00152 DOUBLE PRECISION ANORM, RCOND 00153 * .. 00154 * .. Array Arguments .. 00155 INTEGER IPIV( * ) 00156 COMPLEX*16 D( * ), DL( * ), DU( * ), DU2( * ), WORK( * ) 00157 * .. 00158 * 00159 * ===================================================================== 00160 * 00161 * .. Parameters .. 00162 DOUBLE PRECISION ONE, ZERO 00163 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) 00164 * .. 00165 * .. Local Scalars .. 00166 LOGICAL ONENRM 00167 INTEGER I, KASE, KASE1 00168 DOUBLE PRECISION AINVNM 00169 * .. 00170 * .. Local Arrays .. 00171 INTEGER ISAVE( 3 ) 00172 * .. 00173 * .. External Functions .. 00174 LOGICAL LSAME 00175 EXTERNAL LSAME 00176 * .. 00177 * .. External Subroutines .. 00178 EXTERNAL XERBLA, ZGTTRS, ZLACN2 00179 * .. 00180 * .. Intrinsic Functions .. 00181 INTRINSIC DCMPLX 00182 * .. 00183 * .. Executable Statements .. 00184 * 00185 * Test the input arguments. 00186 * 00187 INFO = 0 00188 ONENRM = NORM.EQ.'1' .OR. LSAME( NORM, 'O' ) 00189 IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM, 'I' ) ) THEN 00190 INFO = -1 00191 ELSE IF( N.LT.0 ) THEN 00192 INFO = -2 00193 ELSE IF( ANORM.LT.ZERO ) THEN 00194 INFO = -8 00195 END IF 00196 IF( INFO.NE.0 ) THEN 00197 CALL XERBLA( 'ZGTCON', -INFO ) 00198 RETURN 00199 END IF 00200 * 00201 * Quick return if possible 00202 * 00203 RCOND = ZERO 00204 IF( N.EQ.0 ) THEN 00205 RCOND = ONE 00206 RETURN 00207 ELSE IF( ANORM.EQ.ZERO ) THEN 00208 RETURN 00209 END IF 00210 * 00211 * Check that D(1:N) is non-zero. 00212 * 00213 DO 10 I = 1, N 00214 IF( D( I ).EQ.DCMPLX( ZERO ) ) 00215 $ RETURN 00216 10 CONTINUE 00217 * 00218 AINVNM = ZERO 00219 IF( ONENRM ) THEN 00220 KASE1 = 1 00221 ELSE 00222 KASE1 = 2 00223 END IF 00224 KASE = 0 00225 20 CONTINUE 00226 CALL ZLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE ) 00227 IF( KASE.NE.0 ) THEN 00228 IF( KASE.EQ.KASE1 ) THEN 00229 * 00230 * Multiply by inv(U)*inv(L). 00231 * 00232 CALL ZGTTRS( 'No transpose', N, 1, DL, D, DU, DU2, IPIV, 00233 $ WORK, N, INFO ) 00234 ELSE 00235 * 00236 * Multiply by inv(L**H)*inv(U**H). 00237 * 00238 CALL ZGTTRS( 'Conjugate transpose', N, 1, DL, D, DU, DU2, 00239 $ IPIV, WORK, N, INFO ) 00240 END IF 00241 GO TO 20 00242 END IF 00243 * 00244 * Compute the estimate of the reciprocal condition number. 00245 * 00246 IF( AINVNM.NE.ZERO ) 00247 $ RCOND = ( ONE / AINVNM ) / ANORM 00248 * 00249 RETURN 00250 * 00251 * End of ZGTCON 00252 * 00253 END