File:  [local] / rpl / lapack / lapack / dlangt.f
Revision 1.18: download - view: text, annotated - select for diffs - revision graph
Mon Aug 7 08:38:55 2023 UTC (8 months, 3 weeks ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_35, rpl-4_1_34, HEAD
Première mise à jour de lapack et blas.

    1: *> \brief \b DLANGT returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of a general tridiagonal matrix.
    2: *
    3: *  =========== DOCUMENTATION ===========
    4: *
    5: * Online html documentation available at
    6: *            http://www.netlib.org/lapack/explore-html/
    7: *
    8: *> \htmlonly
    9: *> Download DLANGT + dependencies
   10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlangt.f">
   11: *> [TGZ]</a>
   12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlangt.f">
   13: *> [ZIP]</a>
   14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlangt.f">
   15: *> [TXT]</a>
   16: *> \endhtmlonly
   17: *
   18: *  Definition:
   19: *  ===========
   20: *
   21: *       DOUBLE PRECISION FUNCTION DLANGT( NORM, N, DL, D, DU )
   22: *
   23: *       .. Scalar Arguments ..
   24: *       CHARACTER          NORM
   25: *       INTEGER            N
   26: *       ..
   27: *       .. Array Arguments ..
   28: *       DOUBLE PRECISION   D( * ), DL( * ), DU( * )
   29: *       ..
   30: *
   31: *
   32: *> \par Purpose:
   33: *  =============
   34: *>
   35: *> \verbatim
   36: *>
   37: *> DLANGT  returns the value of the one norm,  or the Frobenius norm, or
   38: *> the  infinity norm,  or the  element of  largest absolute value  of a
   39: *> real tridiagonal matrix A.
   40: *> \endverbatim
   41: *>
   42: *> \return DLANGT
   43: *> \verbatim
   44: *>
   45: *>    DLANGT = ( max(abs(A(i,j))), NORM = 'M' or 'm'
   46: *>             (
   47: *>             ( norm1(A),         NORM = '1', 'O' or 'o'
   48: *>             (
   49: *>             ( normI(A),         NORM = 'I' or 'i'
   50: *>             (
   51: *>             ( normF(A),         NORM = 'F', 'f', 'E' or 'e'
   52: *>
   53: *> where  norm1  denotes the  one norm of a matrix (maximum column sum),
   54: *> normI  denotes the  infinity norm  of a matrix  (maximum row sum) and
   55: *> normF  denotes the  Frobenius norm of a matrix (square root of sum of
   56: *> squares).  Note that  max(abs(A(i,j)))  is not a consistent matrix norm.
   57: *> \endverbatim
   58: *
   59: *  Arguments:
   60: *  ==========
   61: *
   62: *> \param[in] NORM
   63: *> \verbatim
   64: *>          NORM is CHARACTER*1
   65: *>          Specifies the value to be returned in DLANGT as described
   66: *>          above.
   67: *> \endverbatim
   68: *>
   69: *> \param[in] N
   70: *> \verbatim
   71: *>          N is INTEGER
   72: *>          The order of the matrix A.  N >= 0.  When N = 0, DLANGT is
   73: *>          set to zero.
   74: *> \endverbatim
   75: *>
   76: *> \param[in] DL
   77: *> \verbatim
   78: *>          DL is DOUBLE PRECISION array, dimension (N-1)
   79: *>          The (n-1) sub-diagonal elements of A.
   80: *> \endverbatim
   81: *>
   82: *> \param[in] D
   83: *> \verbatim
   84: *>          D is DOUBLE PRECISION array, dimension (N)
   85: *>          The diagonal elements of A.
   86: *> \endverbatim
   87: *>
   88: *> \param[in] DU
   89: *> \verbatim
   90: *>          DU is DOUBLE PRECISION array, dimension (N-1)
   91: *>          The (n-1) super-diagonal elements of A.
   92: *> \endverbatim
   93: *
   94: *  Authors:
   95: *  ========
   96: *
   97: *> \author Univ. of Tennessee
   98: *> \author Univ. of California Berkeley
   99: *> \author Univ. of Colorado Denver
  100: *> \author NAG Ltd.
  101: *
  102: *> \ingroup doubleOTHERauxiliary
  103: *
  104: *  =====================================================================
  105:       DOUBLE PRECISION FUNCTION DLANGT( NORM, N, DL, D, DU )
  106: *
  107: *  -- LAPACK auxiliary routine --
  108: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  109: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  110: *
  111: *     .. Scalar Arguments ..
  112:       CHARACTER          NORM
  113:       INTEGER            N
  114: *     ..
  115: *     .. Array Arguments ..
  116:       DOUBLE PRECISION   D( * ), DL( * ), DU( * )
  117: *     ..
  118: *
  119: *  =====================================================================
  120: *
  121: *     .. Parameters ..
  122:       DOUBLE PRECISION   ONE, ZERO
  123:       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
  124: *     ..
  125: *     .. Local Scalars ..
  126:       INTEGER            I
  127:       DOUBLE PRECISION   ANORM, SCALE, SUM, TEMP
  128: *     ..
  129: *     .. External Functions ..
  130:       LOGICAL            LSAME, DISNAN
  131:       EXTERNAL           LSAME, DISNAN
  132: *     ..
  133: *     .. External Subroutines ..
  134:       EXTERNAL           DLASSQ
  135: *     ..
  136: *     .. Intrinsic Functions ..
  137:       INTRINSIC          ABS, SQRT
  138: *     ..
  139: *     .. Executable Statements ..
  140: *
  141:       IF( N.LE.0 ) THEN
  142:          ANORM = ZERO
  143:       ELSE IF( LSAME( NORM, 'M' ) ) THEN
  144: *
  145: *        Find max(abs(A(i,j))).
  146: *
  147:          ANORM = ABS( D( N ) )
  148:          DO 10 I = 1, N - 1
  149:             IF( ANORM.LT.ABS( DL( I ) ) .OR. DISNAN( ABS( DL( I ) ) ) )
  150:      $           ANORM = ABS(DL(I))
  151:             IF( ANORM.LT.ABS( D( I ) ) .OR. DISNAN( ABS( D( I ) ) ) )
  152:      $           ANORM = ABS(D(I))
  153:             IF( ANORM.LT.ABS( DU( I ) ) .OR. DISNAN (ABS( DU( I ) ) ) )
  154:      $           ANORM = ABS(DU(I))
  155:    10    CONTINUE
  156:       ELSE IF( LSAME( NORM, 'O' ) .OR. NORM.EQ.'1' ) THEN
  157: *
  158: *        Find norm1(A).
  159: *
  160:          IF( N.EQ.1 ) THEN
  161:             ANORM = ABS( D( 1 ) )
  162:          ELSE
  163:             ANORM = ABS( D( 1 ) )+ABS( DL( 1 ) )
  164:             TEMP = ABS( D( N ) )+ABS( DU( N-1 ) )
  165:             IF( ANORM .LT. TEMP .OR. DISNAN( TEMP ) ) ANORM = TEMP
  166:             DO 20 I = 2, N - 1
  167:                TEMP = ABS( D( I ) )+ABS( DL( I ) )+ABS( DU( I-1 ) )
  168:                IF( ANORM .LT. TEMP .OR. DISNAN( TEMP ) ) ANORM = TEMP
  169:    20       CONTINUE
  170:          END IF
  171:       ELSE IF( LSAME( NORM, 'I' ) ) THEN
  172: *
  173: *        Find normI(A).
  174: *
  175:          IF( N.EQ.1 ) THEN
  176:             ANORM = ABS( D( 1 ) )
  177:          ELSE
  178:             ANORM = ABS( D( 1 ) )+ABS( DU( 1 ) )
  179:             TEMP = ABS( D( N ) )+ABS( DL( N-1 ) )
  180:             IF( ANORM .LT. TEMP .OR. DISNAN( TEMP ) ) ANORM = TEMP
  181:             DO 30 I = 2, N - 1
  182:                TEMP = ABS( D( I ) )+ABS( DU( I ) )+ABS( DL( I-1 ) )
  183:                IF( ANORM .LT. TEMP .OR. DISNAN( TEMP ) ) ANORM = TEMP
  184:    30       CONTINUE
  185:          END IF
  186:       ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
  187: *
  188: *        Find normF(A).
  189: *
  190:          SCALE = ZERO
  191:          SUM = ONE
  192:          CALL DLASSQ( N, D, 1, SCALE, SUM )
  193:          IF( N.GT.1 ) THEN
  194:             CALL DLASSQ( N-1, DL, 1, SCALE, SUM )
  195:             CALL DLASSQ( N-1, DU, 1, SCALE, SUM )
  196:          END IF
  197:          ANORM = SCALE*SQRT( SUM )
  198:       END IF
  199: *
  200:       DLANGT = ANORM
  201:       RETURN
  202: *
  203: *     End of DLANGT
  204: *
  205:       END

CVSweb interface <joel.bertrand@systella.fr>