SRC/zgtcon.f

   1 *> \brief \b ZGTCON
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *> \htmlonly
   9 *> Download ZGTCON + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgtcon.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgtcon.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgtcon.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       SUBROUTINE ZGTCON( NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND,
  22 *                          WORK, INFO )
  23 *
  24 *       .. Scalar Arguments ..
  25 *       CHARACTER          NORM
  26 *       INTEGER            INFO, N
  27 *       DOUBLE PRECISION   ANORM, RCOND
  28 *       ..
  29 *       .. Array Arguments ..
  30 *       INTEGER            IPIV( * )
  31 *       COMPLEX*16         D( * ), DL( * ), DU( * ), DU2( * ), WORK( * )
  32 *       ..
  33 *
  34 *
  35 *> \par Purpose:
  36 *  =============
  37 *>
  38 *> \verbatim
  39 *>
  40 *> ZGTCON estimates the reciprocal of the condition number of a complex
  41 *> tridiagonal matrix A using the LU factorization as computed by
  42 *> ZGTTRF.
  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 COMPLEX*16 array, dimension (N-1)
  69 *>          The (n-1) multipliers that define the matrix L from the
  70 *>          LU factorization of A as computed by ZGTTRF.
  71 *> \endverbatim
  72 *>
  73 *> \param[in] D
  74 *> \verbatim
  75 *>          D is COMPLEX*16 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 COMPLEX*16 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 COMPLEX*16 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 DOUBLE PRECISION
 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 DOUBLE PRECISION
 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 COMPLEX*16 array, dimension (2*N)
 119 *> \endverbatim
 120 *>
 121 *> \param[out] INFO
 122 *> \verbatim
 123 *>          INFO is INTEGER
 124 *>          = 0:  successful exit
 125 *>          < 0:  if INFO = -i, the i-th argument had an illegal value
 126 *> \endverbatim
 127 *
 128 *  Authors:
 129 *  ========
 130 *
 131 *> \author Univ. of Tennessee
 132 *> \author Univ. of California Berkeley
 133 *> \author Univ. of Colorado Denver
 134 *> \author NAG Ltd.
 135 *
 136 *> \date September 2012
 137 *
 138 *> \ingroup complex16GTcomputational
 139 *
 140 *  =====================================================================
 141       SUBROUTINE ZGTCON( NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND,
 142      $                   WORK, INFO )
 143 *
 144 *  -- LAPACK computational routine (version 3.4.2) --
 145 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 146 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 147 *     September 2012
 148 *
 149 *     .. Scalar Arguments ..
 150       CHARACTER          NORM
 151       INTEGER            INFO, N
 152       DOUBLE PRECISION   ANORM, RCOND
 153 *     ..
 154 *     .. Array Arguments ..
 155       INTEGER            IPIV( * )
 156       COMPLEX*16         D( * ), DL( * ), DU( * ), DU2( * ), WORK( * )
 157 *     ..
 158 *
 159 *  =====================================================================
 160 *
 161 *     .. Parameters ..
 162       DOUBLE PRECISION   ONE, ZERO
 163       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
 164 *     ..
 165 *     .. Local Scalars ..
 166       LOGICAL            ONENRM
 167       INTEGER            I, KASE, KASE1
 168       DOUBLE PRECISION   AINVNM
 169 *     ..
 170 *     .. Local Arrays ..
 171       INTEGER            ISAVE( 3 )
 172 *     ..
 173 *     .. External Functions ..
 174       LOGICAL            LSAME
 175       EXTERNAL           LSAME
 176 *     ..
 177 *     .. External Subroutines ..
 178       EXTERNAL           XERBLA, ZGTTRS, ZLACN2
 179 *     ..
 180 *     .. Intrinsic Functions ..
 181       INTRINSIC          DCMPLX
 182 *     ..
 183 *     .. Executable Statements ..
 184 *
 185 *     Test the input arguments.
 186 *
 187       INFO = 0
 188       ONENRM = NORM.EQ.'1' .OR. LSAME( NORM, 'O' )
 189       IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM, 'I' ) ) THEN
 190          INFO = -1
 191       ELSE IF( N.LT.0 ) THEN
 192          INFO = -2
 193       ELSE IF( ANORM.LT.ZERO ) THEN
 194          INFO = -8
 195       END IF
 196       IF( INFO.NE.0 ) THEN
 197          CALL XERBLA( 'ZGTCON', -INFO )
 198          RETURN
 199       END IF
 200 *
 201 *     Quick return if possible
 202 *
 203       RCOND = ZERO
 204       IF( N.EQ.0 ) THEN
 205          RCOND = ONE
 206          RETURN
 207       ELSE IF( ANORM.EQ.ZERO ) THEN
 208          RETURN
 209       END IF
 210 *
 211 *     Check that D(1:N) is non-zero.
 212 *
 213       DO 10 I = 1, N
 214          IF( D( I ).EQ.DCMPLX( ZERO ) )
 215      $      RETURN
 216    10 CONTINUE
 217 *
 218       AINVNM = ZERO
 219       IF( ONENRM ) THEN
 220          KASE1 = 1
 221       ELSE
 222          KASE1 = 2
 223       END IF
 224       KASE = 0
 225    20 CONTINUE
 226       CALL ZLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE )
 227       IF( KASE.NE.0 ) THEN
 228          IF( KASE.EQ.KASE1 ) THEN
 229 *
 230 *           Multiply by inv(U)*inv(L).
 231 *
 232             CALL ZGTTRS( 'No transpose', N, 1, DL, D, DU, DU2, IPIV,
 233      $                   WORK, N, INFO )
 234          ELSE
 235 *
 236 *           Multiply by inv(L**H)*inv(U**H).
 237 *
 238             CALL ZGTTRS( 'Conjugate transpose', N, 1, DL, D, DU, DU2,
 239      $                   IPIV, WORK, N, INFO )
 240          END IF
 241          GO TO 20
 242       END IF
 243 *
 244 *     Compute the estimate of the reciprocal condition number.
 245 *
 246       IF( AINVNM.NE.ZERO )
 247      $   RCOND = ( ONE / AINVNM ) / ANORM
 248 *
 249       RETURN
 250 *
 251 *     End of ZGTCON
 252 *
 253       END