SRC/sgtcon.f

   1 *> \brief \b SGTCON
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *> \htmlonly
   9 *> Download SGTCON + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgtcon.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgtcon.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgtcon.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       SUBROUTINE SGTCON( NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND,
  22 *                          WORK, IWORK, INFO )
  23 *
  24 *       .. Scalar Arguments ..
  25 *       CHARACTER          NORM
  26 *       INTEGER            INFO, N
  27 *       REAL               ANORM, RCOND
  28 *       ..
  29 *       .. Array Arguments ..
  30 *       INTEGER            IPIV( * ), IWORK( * )
  31 *       REAL               D( * ), DL( * ), DU( * ), DU2( * ), WORK( * )
  32 *       ..
  33 *
  34 *
  35 *> \par Purpose:
  36 *  =============
  37 *>
  38 *> \verbatim
  39 *>
  40 *> SGTCON estimates the reciprocal of the condition number of a real
  41 *> tridiagonal matrix A using the LU factorization as computed by
  42 *> SGTTRF.
  43 *>
  44 *> An estimate is obtained for norm(inv(A)), and the reciprocal of the
  45 *> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
  46 *> \endverbatim
  47 *
  48 *  Arguments:
  49 *  ==========
  50 *
  51 *> \param[in] NORM
  52 *> \verbatim
  53 *>          NORM is CHARACTER*1
  54 *>          Specifies whether the 1-norm condition number or the
  55 *>          infinity-norm condition number is required:
  56 *>          = '1' or 'O':  1-norm;
  57 *>          = 'I':         Infinity-norm.
  58 *> \endverbatim
  59 *>
  60 *> \param[in] N
  61 *> \verbatim
  62 *>          N is INTEGER
  63 *>          The order of the matrix A.  N >= 0.
  64 *> \endverbatim
  65 *>
  66 *> \param[in] DL
  67 *> \verbatim
  68 *>          DL is REAL array, dimension (N-1)
  69 *>          The (n-1) multipliers that define the matrix L from the
  70 *>          LU factorization of A as computed by SGTTRF.
  71 *> \endverbatim
  72 *>
  73 *> \param[in] D
  74 *> \verbatim
  75 *>          D is REAL array, dimension (N)
  76 *>          The n diagonal elements of the upper triangular matrix U from
  77 *>          the LU factorization of A.
  78 *> \endverbatim
  79 *>
  80 *> \param[in] DU
  81 *> \verbatim
  82 *>          DU is REAL array, dimension (N-1)
  83 *>          The (n-1) elements of the first superdiagonal of U.
  84 *> \endverbatim
  85 *>
  86 *> \param[in] DU2
  87 *> \verbatim
  88 *>          DU2 is REAL array, dimension (N-2)
  89 *>          The (n-2) elements of the second superdiagonal of U.
  90 *> \endverbatim
  91 *>
  92 *> \param[in] IPIV
  93 *> \verbatim
  94 *>          IPIV is INTEGER array, dimension (N)
  95 *>          The pivot indices; for 1 <= i <= n, row i of the matrix was
  96 *>          interchanged with row IPIV(i).  IPIV(i) will always be either
  97 *>          i or i+1; IPIV(i) = i indicates a row interchange was not
  98 *>          required.
  99 *> \endverbatim
 100 *>
 101 *> \param[in] ANORM
 102 *> \verbatim
 103 *>          ANORM is REAL
 104 *>          If NORM = '1' or 'O', the 1-norm of the original matrix A.
 105 *>          If NORM = 'I', the infinity-norm of the original matrix A.
 106 *> \endverbatim
 107 *>
 108 *> \param[out] RCOND
 109 *> \verbatim
 110 *>          RCOND is REAL
 111 *>          The reciprocal of the condition number of the matrix A,
 112 *>          computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
 113 *>          estimate of the 1-norm of inv(A) computed in this routine.
 114 *> \endverbatim
 115 *>
 116 *> \param[out] WORK
 117 *> \verbatim
 118 *>          WORK is REAL array, dimension (2*N)
 119 *> \endverbatim
 120 *>
 121 *> \param[out] IWORK
 122 *> \verbatim
 123 *>          IWORK is INTEGER array, dimension (N)
 124 *> \endverbatim
 125 *>
 126 *> \param[out] INFO
 127 *> \verbatim
 128 *>          INFO is INTEGER
 129 *>          = 0:  successful exit
 130 *>          < 0:  if INFO = -i, the i-th argument had an illegal value
 131 *> \endverbatim
 132 *
 133 *  Authors:
 134 *  ========
 135 *
 136 *> \author Univ. of Tennessee
 137 *> \author Univ. of California Berkeley
 138 *> \author Univ. of Colorado Denver
 139 *> \author NAG Ltd.
 140 *
 141 *> \date September 2012
 142 *
 143 *> \ingroup realGTcomputational
 144 *
 145 *  =====================================================================
 146       SUBROUTINE SGTCON( NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND,
 147      $                   WORK, IWORK, INFO )
 148 *
 149 *  -- LAPACK computational routine (version 3.4.2) --
 150 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 151 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 152 *     September 2012
 153 *
 154 *     .. Scalar Arguments ..
 155       CHARACTER          NORM
 156       INTEGER            INFO, N
 157       REAL               ANORM, RCOND
 158 *     ..
 159 *     .. Array Arguments ..
 160       INTEGER            IPIV( * ), IWORK( * )
 161       REAL               D( * ), DL( * ), DU( * ), DU2( * ), WORK( * )
 162 *     ..
 163 *
 164 *  =====================================================================
 165 *
 166 *     .. Parameters ..
 167       REAL               ONE, ZERO
 168       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
 169 *     ..
 170 *     .. Local Scalars ..
 171       LOGICAL            ONENRM
 172       INTEGER            I, KASE, KASE1
 173       REAL               AINVNM
 174 *     ..
 175 *     .. Local Arrays ..
 176       INTEGER            ISAVE( 3 )
 177 *     ..
 178 *     .. External Functions ..
 179       LOGICAL            LSAME
 180       EXTERNAL           LSAME
 181 *     ..
 182 *     .. External Subroutines ..
 183       EXTERNAL           SGTTRS, SLACN2, XERBLA
 184 *     ..
 185 *     .. Executable Statements ..
 186 *
 187 *     Test the input arguments.
 188 *
 189       INFO = 0
 190       ONENRM = NORM.EQ.'1' .OR. LSAME( NORM, 'O' )
 191       IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM, 'I' ) ) THEN
 192          INFO = -1
 193       ELSE IF( N.LT.0 ) THEN
 194          INFO = -2
 195       ELSE IF( ANORM.LT.ZERO ) THEN
 196          INFO = -8
 197       END IF
 198       IF( INFO.NE.0 ) THEN
 199          CALL XERBLA( 'SGTCON', -INFO )
 200          RETURN
 201       END IF
 202 *
 203 *     Quick return if possible
 204 *
 205       RCOND = ZERO
 206       IF( N.EQ.0 ) THEN
 207          RCOND = ONE
 208          RETURN
 209       ELSE IF( ANORM.EQ.ZERO ) THEN
 210          RETURN
 211       END IF
 212 *
 213 *     Check that D(1:N) is non-zero.
 214 *
 215       DO 10 I = 1, N
 216          IF( D( I ).EQ.ZERO )
 217      $      RETURN
 218    10 CONTINUE
 219 *
 220       AINVNM = ZERO
 221       IF( ONENRM ) THEN
 222          KASE1 = 1
 223       ELSE
 224          KASE1 = 2
 225       END IF
 226       KASE = 0
 227    20 CONTINUE
 228       CALL SLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
 229       IF( KASE.NE.0 ) THEN
 230          IF( KASE.EQ.KASE1 ) THEN
 231 *
 232 *           Multiply by inv(U)*inv(L).
 233 *
 234             CALL SGTTRS( 'No transpose', N, 1, DL, D, DU, DU2, IPIV,
 235      $                   WORK, N, INFO )
 236          ELSE
 237 *
 238 *           Multiply by inv(L**T)*inv(U**T).
 239 *
 240             CALL SGTTRS( 'Transpose', N, 1, DL, D, DU, DU2, IPIV, WORK,
 241      $                   N, INFO )
 242          END IF
 243          GO TO 20
 244       END IF
 245 *
 246 *     Compute the estimate of the reciprocal condition number.
 247 *
 248       IF( AINVNM.NE.ZERO )
 249      $   RCOND = ( ONE / AINVNM ) / ANORM
 250 *
 251       RETURN
 252 *
 253 *     End of SGTCON
 254 *
 255       END