00001 SUBROUTINE SGTCON( NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND, 00002 $ WORK, IWORK, INFO ) 00003 * 00004 * -- LAPACK routine (version 3.2) -- 00005 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00006 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00007 * November 2006 00008 * 00009 * Modified to call SLACN2 in place of SLACON, 7 Feb 03, SJH. 00010 * 00011 * .. Scalar Arguments .. 00012 CHARACTER NORM 00013 INTEGER INFO, N 00014 REAL ANORM, RCOND 00015 * .. 00016 * .. Array Arguments .. 00017 INTEGER IPIV( * ), IWORK( * ) 00018 REAL D( * ), DL( * ), DU( * ), DU2( * ), WORK( * ) 00019 * .. 00020 * 00021 * Purpose 00022 * ======= 00023 * 00024 * SGTCON estimates the reciprocal of the condition number of a real 00025 * tridiagonal matrix A using the LU factorization as computed by 00026 * SGTTRF. 00027 * 00028 * An estimate is obtained for norm(inv(A)), and the reciprocal of the 00029 * condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). 00030 * 00031 * Arguments 00032 * ========= 00033 * 00034 * NORM (input) CHARACTER*1 00035 * Specifies whether the 1-norm condition number or the 00036 * infinity-norm condition number is required: 00037 * = '1' or 'O': 1-norm; 00038 * = 'I': Infinity-norm. 00039 * 00040 * N (input) INTEGER 00041 * The order of the matrix A. N >= 0. 00042 * 00043 * DL (input) REAL array, dimension (N-1) 00044 * The (n-1) multipliers that define the matrix L from the 00045 * LU factorization of A as computed by SGTTRF. 00046 * 00047 * D (input) REAL array, dimension (N) 00048 * The n diagonal elements of the upper triangular matrix U from 00049 * the LU factorization of A. 00050 * 00051 * DU (input) REAL array, dimension (N-1) 00052 * The (n-1) elements of the first superdiagonal of U. 00053 * 00054 * DU2 (input) REAL array, dimension (N-2) 00055 * The (n-2) elements of the second superdiagonal of U. 00056 * 00057 * IPIV (input) INTEGER array, dimension (N) 00058 * The pivot indices; for 1 <= i <= n, row i of the matrix was 00059 * interchanged with row IPIV(i). IPIV(i) will always be either 00060 * i or i+1; IPIV(i) = i indicates a row interchange was not 00061 * required. 00062 * 00063 * ANORM (input) REAL 00064 * If NORM = '1' or 'O', the 1-norm of the original matrix A. 00065 * If NORM = 'I', the infinity-norm of the original matrix A. 00066 * 00067 * RCOND (output) REAL 00068 * The reciprocal of the condition number of the matrix A, 00069 * computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an 00070 * estimate of the 1-norm of inv(A) computed in this routine. 00071 * 00072 * WORK (workspace) REAL array, dimension (2*N) 00073 * 00074 * IWORK (workspace) INTEGER array, dimension (N) 00075 * 00076 * INFO (output) INTEGER 00077 * = 0: successful exit 00078 * < 0: if INFO = -i, the i-th argument had an illegal value 00079 * 00080 * ===================================================================== 00081 * 00082 * .. Parameters .. 00083 REAL ONE, ZERO 00084 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 00085 * .. 00086 * .. Local Scalars .. 00087 LOGICAL ONENRM 00088 INTEGER I, KASE, KASE1 00089 REAL AINVNM 00090 * .. 00091 * .. Local Arrays .. 00092 INTEGER ISAVE( 3 ) 00093 * .. 00094 * .. External Functions .. 00095 LOGICAL LSAME 00096 EXTERNAL LSAME 00097 * .. 00098 * .. External Subroutines .. 00099 EXTERNAL SGTTRS, SLACN2, XERBLA 00100 * .. 00101 * .. Executable Statements .. 00102 * 00103 * Test the input arguments. 00104 * 00105 INFO = 0 00106 ONENRM = NORM.EQ.'1' .OR. LSAME( NORM, 'O' ) 00107 IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM, 'I' ) ) THEN 00108 INFO = -1 00109 ELSE IF( N.LT.0 ) THEN 00110 INFO = -2 00111 ELSE IF( ANORM.LT.ZERO ) THEN 00112 INFO = -8 00113 END IF 00114 IF( INFO.NE.0 ) THEN 00115 CALL XERBLA( 'SGTCON', -INFO ) 00116 RETURN 00117 END IF 00118 * 00119 * Quick return if possible 00120 * 00121 RCOND = ZERO 00122 IF( N.EQ.0 ) THEN 00123 RCOND = ONE 00124 RETURN 00125 ELSE IF( ANORM.EQ.ZERO ) THEN 00126 RETURN 00127 END IF 00128 * 00129 * Check that D(1:N) is non-zero. 00130 * 00131 DO 10 I = 1, N 00132 IF( D( I ).EQ.ZERO ) 00133 $ RETURN 00134 10 CONTINUE 00135 * 00136 AINVNM = ZERO 00137 IF( ONENRM ) THEN 00138 KASE1 = 1 00139 ELSE 00140 KASE1 = 2 00141 END IF 00142 KASE = 0 00143 20 CONTINUE 00144 CALL SLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE ) 00145 IF( KASE.NE.0 ) THEN 00146 IF( KASE.EQ.KASE1 ) THEN 00147 * 00148 * Multiply by inv(U)*inv(L). 00149 * 00150 CALL SGTTRS( 'No transpose', N, 1, DL, D, DU, DU2, IPIV, 00151 $ WORK, N, INFO ) 00152 ELSE 00153 * 00154 * Multiply by inv(L')*inv(U'). 00155 * 00156 CALL SGTTRS( 'Transpose', N, 1, DL, D, DU, DU2, IPIV, WORK, 00157 $ N, INFO ) 00158 END IF 00159 GO TO 20 00160 END IF 00161 * 00162 * Compute the estimate of the reciprocal condition number. 00163 * 00164 IF( AINVNM.NE.ZERO ) 00165 $ RCOND = ( ONE / AINVNM ) / ANORM 00166 * 00167 RETURN 00168 * 00169 * End of SGTCON 00170 * 00171 END
1.7.2