LAPACK 3.3.1 Linear Algebra PACKage

# dgtcon.f

Go to the documentation of this file.
```00001       SUBROUTINE DGTCON( NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND,
00002      \$                   WORK, IWORK, INFO )
00003 *
00004 *  -- LAPACK routine (version 3.3.1) --
00005 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00006 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00007 *  -- April 2011                                                      --
00008 *
00009 *     Modified to call DLACN2 in place of DLACON, 5 Feb 03, SJH.
00010 *
00011 *     .. Scalar Arguments ..
00012       CHARACTER          NORM
00013       INTEGER            INFO, N
00014       DOUBLE PRECISION   ANORM, RCOND
00015 *     ..
00016 *     .. Array Arguments ..
00017       INTEGER            IPIV( * ), IWORK( * )
00018       DOUBLE PRECISION   D( * ), DL( * ), DU( * ), DU2( * ), WORK( * )
00019 *     ..
00020 *
00021 *  Purpose
00022 *  =======
00023 *
00024 *  DGTCON estimates the reciprocal of the condition number of a real
00025 *  tridiagonal matrix A using the LU factorization as computed by
00026 *  DGTTRF.
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) DOUBLE PRECISION array, dimension (N-1)
00044 *          The (n-1) multipliers that define the matrix L from the
00045 *          LU factorization of A as computed by DGTTRF.
00046 *
00047 *  D       (input) DOUBLE PRECISION 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) DOUBLE PRECISION array, dimension (N-1)
00052 *          The (n-1) elements of the first superdiagonal of U.
00053 *
00054 *  DU2     (input) DOUBLE PRECISION 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) DOUBLE PRECISION
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) DOUBLE PRECISION
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) DOUBLE PRECISION 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       DOUBLE PRECISION   ONE, ZERO
00084       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
00085 *     ..
00086 *     .. Local Scalars ..
00087       LOGICAL            ONENRM
00088       INTEGER            I, KASE, KASE1
00089       DOUBLE PRECISION   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           DGTTRS, DLACN2, 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( 'DGTCON', -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 DLACN2( 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 DGTTRS( 'No transpose', N, 1, DL, D, DU, DU2, IPIV,
00151      \$                   WORK, N, INFO )
00152          ELSE
00153 *
00154 *           Multiply by inv(L**T)*inv(U**T).
00155 *
00156             CALL DGTTRS( '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 DGTCON
00170 *
00171       END
```