![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SGTCON 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download SGTCON + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgtcon.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgtcon.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgtcon.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE SGTCON( NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND, 00022 * WORK, IWORK, INFO ) 00023 * 00024 * .. Scalar Arguments .. 00025 * CHARACTER NORM 00026 * INTEGER INFO, N 00027 * REAL ANORM, RCOND 00028 * .. 00029 * .. Array Arguments .. 00030 * INTEGER IPIV( * ), IWORK( * ) 00031 * REAL D( * ), DL( * ), DU( * ), DU2( * ), WORK( * ) 00032 * .. 00033 * 00034 * 00035 *> \par Purpose: 00036 * ============= 00037 *> 00038 *> \verbatim 00039 *> 00040 *> SGTCON estimates the reciprocal of the condition number of a real 00041 *> tridiagonal matrix A using the LU factorization as computed by 00042 *> SGTTRF. 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 REAL array, dimension (N-1) 00069 *> The (n-1) multipliers that define the matrix L from the 00070 *> LU factorization of A as computed by SGTTRF. 00071 *> \endverbatim 00072 *> 00073 *> \param[in] D 00074 *> \verbatim 00075 *> D is REAL 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 REAL 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 REAL 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 REAL 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 REAL 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 REAL array, dimension (2*N) 00119 *> \endverbatim 00120 *> 00121 *> \param[out] IWORK 00122 *> \verbatim 00123 *> IWORK is INTEGER array, dimension (N) 00124 *> \endverbatim 00125 *> 00126 *> \param[out] INFO 00127 *> \verbatim 00128 *> INFO is INTEGER 00129 *> = 0: successful exit 00130 *> < 0: if INFO = -i, the i-th argument had an illegal value 00131 *> \endverbatim 00132 * 00133 * Authors: 00134 * ======== 00135 * 00136 *> \author Univ. of Tennessee 00137 *> \author Univ. of California Berkeley 00138 *> \author Univ. of Colorado Denver 00139 *> \author NAG Ltd. 00140 * 00141 *> \date November 2011 00142 * 00143 *> \ingroup realOTHERcomputational 00144 * 00145 * ===================================================================== 00146 SUBROUTINE SGTCON( NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND, 00147 $ WORK, IWORK, INFO ) 00148 * 00149 * -- LAPACK computational routine (version 3.4.0) -- 00150 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00151 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00152 * November 2011 00153 * 00154 * .. Scalar Arguments .. 00155 CHARACTER NORM 00156 INTEGER INFO, N 00157 REAL ANORM, RCOND 00158 * .. 00159 * .. Array Arguments .. 00160 INTEGER IPIV( * ), IWORK( * ) 00161 REAL D( * ), DL( * ), DU( * ), DU2( * ), WORK( * ) 00162 * .. 00163 * 00164 * ===================================================================== 00165 * 00166 * .. Parameters .. 00167 REAL ONE, ZERO 00168 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 00169 * .. 00170 * .. Local Scalars .. 00171 LOGICAL ONENRM 00172 INTEGER I, KASE, KASE1 00173 REAL AINVNM 00174 * .. 00175 * .. Local Arrays .. 00176 INTEGER ISAVE( 3 ) 00177 * .. 00178 * .. External Functions .. 00179 LOGICAL LSAME 00180 EXTERNAL LSAME 00181 * .. 00182 * .. External Subroutines .. 00183 EXTERNAL SGTTRS, SLACN2, XERBLA 00184 * .. 00185 * .. Executable Statements .. 00186 * 00187 * Test the input arguments. 00188 * 00189 INFO = 0 00190 ONENRM = NORM.EQ.'1' .OR. LSAME( NORM, 'O' ) 00191 IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM, 'I' ) ) THEN 00192 INFO = -1 00193 ELSE IF( N.LT.0 ) THEN 00194 INFO = -2 00195 ELSE IF( ANORM.LT.ZERO ) THEN 00196 INFO = -8 00197 END IF 00198 IF( INFO.NE.0 ) THEN 00199 CALL XERBLA( 'SGTCON', -INFO ) 00200 RETURN 00201 END IF 00202 * 00203 * Quick return if possible 00204 * 00205 RCOND = ZERO 00206 IF( N.EQ.0 ) THEN 00207 RCOND = ONE 00208 RETURN 00209 ELSE IF( ANORM.EQ.ZERO ) THEN 00210 RETURN 00211 END IF 00212 * 00213 * Check that D(1:N) is non-zero. 00214 * 00215 DO 10 I = 1, N 00216 IF( D( I ).EQ.ZERO ) 00217 $ RETURN 00218 10 CONTINUE 00219 * 00220 AINVNM = ZERO 00221 IF( ONENRM ) THEN 00222 KASE1 = 1 00223 ELSE 00224 KASE1 = 2 00225 END IF 00226 KASE = 0 00227 20 CONTINUE 00228 CALL SLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE ) 00229 IF( KASE.NE.0 ) THEN 00230 IF( KASE.EQ.KASE1 ) THEN 00231 * 00232 * Multiply by inv(U)*inv(L). 00233 * 00234 CALL SGTTRS( 'No transpose', N, 1, DL, D, DU, DU2, IPIV, 00235 $ WORK, N, INFO ) 00236 ELSE 00237 * 00238 * Multiply by inv(L**T)*inv(U**T). 00239 * 00240 CALL SGTTRS( 'Transpose', N, 1, DL, D, DU, DU2, IPIV, WORK, 00241 $ N, INFO ) 00242 END IF 00243 GO TO 20 00244 END IF 00245 * 00246 * Compute the estimate of the reciprocal condition number. 00247 * 00248 IF( AINVNM.NE.ZERO ) 00249 $ RCOND = ( ONE / AINVNM ) / ANORM 00250 * 00251 RETURN 00252 * 00253 * End of SGTCON 00254 * 00255 END