SRC/slangt.f

   1 *> \brief \b SLANGT 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 SLANGT + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slangt.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slangt.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slangt.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       REAL             FUNCTION SLANGT( NORM, N, DL, D, DU )
  22 *
  23 *       .. Scalar Arguments ..
  24 *       CHARACTER          NORM
  25 *       INTEGER            N
  26 *       ..
  27 *       .. Array Arguments ..
  28 *       REAL               D( * ), DL( * ), DU( * )
  29 *       ..
  30 *
  31 *
  32 *> \par Purpose:
  33 *  =============
  34 *>
  35 *> \verbatim
  36 *>
  37 *> SLANGT  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 SLANGT
  43 *> \verbatim
  44 *>
  45 *>    SLANGT = ( 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 SLANGT 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, SLANGT is
  73 *>          set to zero.
  74 *> \endverbatim
  75 *>
  76 *> \param[in] DL
  77 *> \verbatim
  78 *>          DL is REAL 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 REAL array, dimension (N)
  85 *>          The diagonal elements of A.
  86 *> \endverbatim
  87 *>
  88 *> \param[in] DU
  89 *> \verbatim
  90 *>          DU is REAL 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 *> \date September 2012
 103 *
 104 *> \ingroup realOTHERauxiliary
 105 *
 106 *  =====================================================================
 107       REAL             FUNCTION SLANGT( NORM, N, DL, D, DU )
 108 *
 109 *  -- LAPACK auxiliary routine (version 3.4.2) --
 110 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 111 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 112 *     September 2012
 113 *
 114 *     .. Scalar Arguments ..
 115       CHARACTER          NORM
 116       INTEGER            N
 117 *     ..
 118 *     .. Array Arguments ..
 119       REAL               D( * ), DL( * ), DU( * )
 120 *     ..
 121 *
 122 *  =====================================================================
 123 *
 124 *     .. Parameters ..
 125       REAL               ONE, ZERO
 126       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
 127 *     ..
 128 *     .. Local Scalars ..
 129       INTEGER            I
 130       REAL               ANORM, SCALE, SUM, TEMP
 131 *     ..
 132 *     .. External Functions ..
 133       LOGICAL            LSAME, SISNAN
 134       EXTERNAL           LSAME, SISNAN
 135 *     ..
 136 *     .. External Subroutines ..
 137       EXTERNAL           SLASSQ
 138 *     ..
 139 *     .. Intrinsic Functions ..
 140       INTRINSIC          ABS, SQRT
 141 *     ..
 142 *     .. Executable Statements ..
 143 *
 144       IF( N.LE.0 ) THEN
 145          ANORM = ZERO
 146       ELSE IF( LSAME( NORM, 'M' ) ) THEN
 147 *
 148 *        Find max(abs(A(i,j))).
 149 *
 150          ANORM = ABS( D( N ) )
 151          DO 10 I = 1, N - 1
 152             IF( ANORM.LT.ABS( DL( I ) ) .OR. SISNAN( ABS( DL( I ) ) ) )
 153      $           ANORM = ABS(DL(I))
 154             IF( ANORM.LT.ABS( D( I ) ) .OR. SISNAN( ABS( D( I ) ) ) )
 155      $           ANORM = ABS(D(I))
 156             IF( ANORM.LT.ABS( DU( I ) ) .OR. SISNAN (ABS( DU( I ) ) ) )
 157      $           ANORM = ABS(DU(I))
 158    10    CONTINUE
 159       ELSE IF( LSAME( NORM, 'O' ) .OR. NORM.EQ.'1' ) THEN
 160 *
 161 *        Find norm1(A).
 162 *
 163          IF( N.EQ.1 ) THEN
 164             ANORM = ABS( D( 1 ) )
 165          ELSE
 166             ANORM = ABS( D( 1 ) )+ABS( DL( 1 ) )
 167             TEMP = ABS( D( N ) )+ABS( DU( N-1 ) )
 168             IF( ANORM .LT. TEMP .OR. SISNAN( TEMP ) ) ANORM = TEMP
 169             DO 20 I = 2, N - 1
 170                TEMP = ABS( D( I ) )+ABS( DL( I ) )+ABS( DU( I-1 ) )
 171                IF( ANORM .LT. TEMP .OR. SISNAN( TEMP ) ) ANORM = TEMP
 172    20       CONTINUE
 173          END IF
 174       ELSE IF( LSAME( NORM, 'I' ) ) THEN
 175 *
 176 *        Find normI(A).
 177 *
 178          IF( N.EQ.1 ) THEN
 179             ANORM = ABS( D( 1 ) )
 180          ELSE
 181             ANORM = ABS( D( 1 ) )+ABS( DU( 1 ) )
 182             TEMP = ABS( D( N ) )+ABS( DL( N-1 ) )
 183             IF( ANORM .LT. TEMP .OR. SISNAN( TEMP ) ) ANORM = TEMP
 184             DO 30 I = 2, N - 1
 185                TEMP = ABS( D( I ) )+ABS( DU( I ) )+ABS( DL( I-1 ) )
 186                IF( ANORM .LT. TEMP .OR. SISNAN( TEMP ) ) ANORM = TEMP
 187    30       CONTINUE
 188          END IF
 189       ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
 190 *
 191 *        Find normF(A).
 192 *
 193          SCALE = ZERO
 194          SUM = ONE
 195          CALL SLASSQ( N, D, 1, SCALE, SUM )
 196          IF( N.GT.1 ) THEN
 197             CALL SLASSQ( N-1, DL, 1, SCALE, SUM )
 198             CALL SLASSQ( N-1, DU, 1, SCALE, SUM )
 199          END IF
 200          ANORM = SCALE*SQRT( SUM )
 201       END IF
 202 *
 203       SLANGT = ANORM
 204       RETURN
 205 *
 206 *     End of SLANGT
 207 *
 208       END