Return to ztbcon.f CVS log

Up to [local] / rpl / lapack / lapack

Cohérence

    1: *> \brief \b ZTBCON
    2: *
    3: *  =========== DOCUMENTATION ===========
    4: *
    5: * Online html documentation available at 
    6: *            http://www.netlib.org/lapack/explore-html/ 
    7: *
    8: *> \htmlonly
    9: *> Download ZTBCON + dependencies 
   10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ztbcon.f"> 
   11: *> [TGZ]</a> 
   12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ztbcon.f"> 
   13: *> [ZIP]</a> 
   14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ztbcon.f"> 
   15: *> [TXT]</a>
   16: *> \endhtmlonly 
   17: *
   18: *  Definition:
   19: *  ===========
   20: *
   21: *       SUBROUTINE ZTBCON( NORM, UPLO, DIAG, N, KD, AB, LDAB, RCOND, WORK,
   22: *                          RWORK, INFO )
   23: * 
   24: *       .. Scalar Arguments ..
   25: *       CHARACTER          DIAG, NORM, UPLO
   26: *       INTEGER            INFO, KD, LDAB, N
   27: *       DOUBLE PRECISION   RCOND
   28: *       ..
   29: *       .. Array Arguments ..
   30: *       DOUBLE PRECISION   RWORK( * )
   31: *       COMPLEX*16         AB( LDAB, * ), WORK( * )
   32: *       ..
   33: *  
   34: *
   35: *> \par Purpose:
   36: *  =============
   37: *>
   38: *> \verbatim
   39: *>
   40: *> ZTBCON estimates the reciprocal of the condition number of a
   41: *> triangular band matrix A, in either the 1-norm or the infinity-norm.
   42: *>
   43: *> The norm of A is computed and an estimate is obtained for
   44: *> norm(inv(A)), then the reciprocal of the condition number is
   45: *> computed as
   46: *>    RCOND = 1 / ( norm(A) * norm(inv(A)) ).
   47: *> \endverbatim
   48: *
   49: *  Arguments:
   50: *  ==========
   51: *
   52: *> \param[in] NORM
   53: *> \verbatim
   54: *>          NORM is CHARACTER*1
   55: *>          Specifies whether the 1-norm condition number or the
   56: *>          infinity-norm condition number is required:
   57: *>          = '1' or 'O':  1-norm;
   58: *>          = 'I':         Infinity-norm.
   59: *> \endverbatim
   60: *>
   61: *> \param[in] UPLO
   62: *> \verbatim
   63: *>          UPLO is CHARACTER*1
   64: *>          = 'U':  A is upper triangular;
   65: *>          = 'L':  A is lower triangular.
   66: *> \endverbatim
   67: *>
   68: *> \param[in] DIAG
   69: *> \verbatim
   70: *>          DIAG is CHARACTER*1
   71: *>          = 'N':  A is non-unit triangular;
   72: *>          = 'U':  A is unit triangular.
   73: *> \endverbatim
   74: *>
   75: *> \param[in] N
   76: *> \verbatim
   77: *>          N is INTEGER
   78: *>          The order of the matrix A.  N >= 0.
   79: *> \endverbatim
   80: *>
   81: *> \param[in] KD
   82: *> \verbatim
   83: *>          KD is INTEGER
   84: *>          The number of superdiagonals or subdiagonals of the
   85: *>          triangular band matrix A.  KD >= 0.
   86: *> \endverbatim
   87: *>
   88: *> \param[in] AB
   89: *> \verbatim
   90: *>          AB is COMPLEX*16 array, dimension (LDAB,N)
   91: *>          The upper or lower triangular band matrix A, stored in the
   92: *>          first kd+1 rows of the array. The j-th column of A is stored
   93: *>          in the j-th column of the array AB as follows:
   94: *>          if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
   95: *>          if UPLO = 'L', AB(1+i-j,j)    = A(i,j) for j<=i<=min(n,j+kd).
   96: *>          If DIAG = 'U', the diagonal elements of A are not referenced
   97: *>          and are assumed to be 1.
   98: *> \endverbatim
   99: *>
  100: *> \param[in] LDAB
  101: *> \verbatim
  102: *>          LDAB is INTEGER
  103: *>          The leading dimension of the array AB.  LDAB >= KD+1.
  104: *> \endverbatim
  105: *>
  106: *> \param[out] RCOND
  107: *> \verbatim
  108: *>          RCOND is DOUBLE PRECISION
  109: *>          The reciprocal of the condition number of the matrix A,
  110: *>          computed as RCOND = 1/(norm(A) * norm(inv(A))).
  111: *> \endverbatim
  112: *>
  113: *> \param[out] WORK
  114: *> \verbatim
  115: *>          WORK is COMPLEX*16 array, dimension (2*N)
  116: *> \endverbatim
  117: *>
  118: *> \param[out] RWORK
  119: *> \verbatim
  120: *>          RWORK is DOUBLE PRECISION array, dimension (N)
  121: *> \endverbatim
  122: *>
  123: *> \param[out] INFO
  124: *> \verbatim
  125: *>          INFO is INTEGER
  126: *>          = 0:  successful exit
  127: *>          < 0:  if INFO = -i, the i-th argument had an illegal value
  128: *> \endverbatim
  129: *
  130: *  Authors:
  131: *  ========
  132: *
  133: *> \author Univ. of Tennessee 
  134: *> \author Univ. of California Berkeley 
  135: *> \author Univ. of Colorado Denver 
  136: *> \author NAG Ltd. 
  137: *
  138: *> \date November 2011
  139: *
  140: *> \ingroup complex16OTHERcomputational
  141: *
  142: *  =====================================================================
  143:       SUBROUTINE ZTBCON( NORM, UPLO, DIAG, N, KD, AB, LDAB, RCOND, WORK,
  144:      $                   RWORK, INFO )
  145: *
  146: *  -- LAPACK computational routine (version 3.4.0) --
  147: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  148: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  149: *     November 2011
  150: *
  151: *     .. Scalar Arguments ..
  152:       CHARACTER          DIAG, NORM, UPLO
  153:       INTEGER            INFO, KD, LDAB, N
  154:       DOUBLE PRECISION   RCOND
  155: *     ..
  156: *     .. Array Arguments ..
  157:       DOUBLE PRECISION   RWORK( * )
  158:       COMPLEX*16         AB( LDAB, * ), WORK( * )
  159: *     ..
  160: *
  161: *  =====================================================================
  162: *
  163: *     .. Parameters ..
  164:       DOUBLE PRECISION   ONE, ZERO
  165:       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
  166: *     ..
  167: *     .. Local Scalars ..
  168:       LOGICAL            NOUNIT, ONENRM, UPPER
  169:       CHARACTER          NORMIN
  170:       INTEGER            IX, KASE, KASE1
  171:       DOUBLE PRECISION   AINVNM, ANORM, SCALE, SMLNUM, XNORM
  172:       COMPLEX*16         ZDUM
  173: *     ..
  174: *     .. Local Arrays ..
  175:       INTEGER            ISAVE( 3 )
  176: *     ..
  177: *     .. External Functions ..
  178:       LOGICAL            LSAME
  179:       INTEGER            IZAMAX
  180:       DOUBLE PRECISION   DLAMCH, ZLANTB
  181:       EXTERNAL           LSAME, IZAMAX, DLAMCH, ZLANTB
  182: *     ..
  183: *     .. External Subroutines ..
  184:       EXTERNAL           XERBLA, ZDRSCL, ZLACN2, ZLATBS
  185: *     ..
  186: *     .. Intrinsic Functions ..
  187:       INTRINSIC          ABS, DBLE, DIMAG, MAX
  188: *     ..
  189: *     .. Statement Functions ..
  190:       DOUBLE PRECISION   CABS1
  191: *     ..
  192: *     .. Statement Function definitions ..
  193:       CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) )
  194: *     ..
  195: *     .. Executable Statements ..
  196: *
  197: *     Test the input parameters.
  198: *
  199:       INFO = 0
  200:       UPPER = LSAME( UPLO, 'U' )
  201:       ONENRM = NORM.EQ.'1' .OR. LSAME( NORM, 'O' )
  202:       NOUNIT = LSAME( DIAG, 'N' )
  203: *
  204:       IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM, 'I' ) ) THEN
  205:          INFO = -1
  206:       ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
  207:          INFO = -2
  208:       ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
  209:          INFO = -3
  210:       ELSE IF( N.LT.0 ) THEN
  211:          INFO = -4
  212:       ELSE IF( KD.LT.0 ) THEN
  213:          INFO = -5
  214:       ELSE IF( LDAB.LT.KD+1 ) THEN
  215:          INFO = -7
  216:       END IF
  217:       IF( INFO.NE.0 ) THEN
  218:          CALL XERBLA( 'ZTBCON', -INFO )
  219:          RETURN
  220:       END IF
  221: *
  222: *     Quick return if possible
  223: *
  224:       IF( N.EQ.0 ) THEN
  225:          RCOND = ONE
  226:          RETURN
  227:       END IF
  228: *
  229:       RCOND = ZERO
  230:       SMLNUM = DLAMCH( 'Safe minimum' )*DBLE( MAX( N, 1 ) )
  231: *
  232: *     Compute the 1-norm of the triangular matrix A or A**H.
  233: *
  234:       ANORM = ZLANTB( NORM, UPLO, DIAG, N, KD, AB, LDAB, RWORK )
  235: *
  236: *     Continue only if ANORM > 0.
  237: *
  238:       IF( ANORM.GT.ZERO ) THEN
  239: *
  240: *        Estimate the 1-norm of the inverse of A.
  241: *
  242:          AINVNM = ZERO
  243:          NORMIN = 'N'
  244:          IF( ONENRM ) THEN
  245:             KASE1 = 1
  246:          ELSE
  247:             KASE1 = 2
  248:          END IF
  249:          KASE = 0
  250:    10    CONTINUE
  251:          CALL ZLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE )
  252:          IF( KASE.NE.0 ) THEN
  253:             IF( KASE.EQ.KASE1 ) THEN
  254: *
  255: *              Multiply by inv(A).
  256: *
  257:                CALL ZLATBS( UPLO, 'No transpose', DIAG, NORMIN, N, KD,
  258:      $                      AB, LDAB, WORK, SCALE, RWORK, INFO )
  259:             ELSE
  260: *
  261: *              Multiply by inv(A**H).
  262: *
  263:                CALL ZLATBS( UPLO, 'Conjugate transpose', DIAG, NORMIN,
  264:      $                      N, KD, AB, LDAB, WORK, SCALE, RWORK, INFO )
  265:             END IF
  266:             NORMIN = 'Y'
  267: *
  268: *           Multiply by 1/SCALE if doing so will not cause overflow.
  269: *
  270:             IF( SCALE.NE.ONE ) THEN
  271:                IX = IZAMAX( N, WORK, 1 )
  272:                XNORM = CABS1( WORK( IX ) )
  273:                IF( SCALE.LT.XNORM*SMLNUM .OR. SCALE.EQ.ZERO )
  274:      $            GO TO 20
  275:                CALL ZDRSCL( N, SCALE, WORK, 1 )
  276:             END IF
  277:             GO TO 10
  278:          END IF
  279: *
  280: *        Compute the estimate of the reciprocal condition number.
  281: *
  282:          IF( AINVNM.NE.ZERO )
  283:      $      RCOND = ( ONE / ANORM ) / AINVNM
  284:       END IF
  285: *
  286:    20 CONTINUE
  287:       RETURN
  288: *
  289: *     End of ZTBCON
  290: *
  291:       END