vendor/gonum.org/v1/gonum/lapack/internal/testdata/dsterftest/dlanst.f

   1 *> \brief \b DLANST returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric 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 DLANST + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlanst.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlanst.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlanst.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       DOUBLE PRECISION FUNCTION DLANST( NORM, N, D, E )
  22 *
  23 *       .. Scalar Arguments ..
  24 *       CHARACTER          NORM
  25 *       INTEGER            N
  26 *       ..
  27 *       .. Array Arguments ..
  28 *       DOUBLE PRECISION   D( * ), E( * )
  29 *       ..
  30 *
  31 *
  32 *> \par Purpose:
  33 *  =============
  34 *>
  35 *> \verbatim
  36 *>
  37 *> DLANST  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 symmetric tridiagonal matrix A.
  40 *> \endverbatim
  41 *>
  42 *> \return DLANST
  43 *> \verbatim
  44 *>
  45 *>    DLANST = ( 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 DLANST 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, DLANST is
  73 *>          set to zero.
  74 *> \endverbatim
  75 *>
  76 *> \param[in] D
  77 *> \verbatim
  78 *>          D is DOUBLE PRECISION array, dimension (N)
  79 *>          The diagonal elements of A.
  80 *> \endverbatim
  81 *>
  82 *> \param[in] E
  83 *> \verbatim
  84 *>          E is DOUBLE PRECISION array, dimension (N-1)
  85 *>          The (n-1) sub-diagonal or super-diagonal elements of A.
  86 *> \endverbatim
  87 *
  88 *  Authors:
  89 *  ========
  90 *
  91 *> \author Univ. of Tennessee
  92 *> \author Univ. of California Berkeley
  93 *> \author Univ. of Colorado Denver
  94 *> \author NAG Ltd.
  95 *
  96 *> \date September 2012
  97 *
  98 *> \ingroup auxOTHERauxiliary
  99 *
 100 *  =====================================================================
 101       DOUBLE PRECISION FUNCTION DLANST( NORM, N, D, E )
 102 *
 103 *  -- LAPACK auxiliary routine (version 3.4.2) --
 104 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 105 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 106 *     September 2012
 107 *
 108 *     .. Scalar Arguments ..
 109       CHARACTER          NORM
 110       INTEGER            N
 111 *     ..
 112 *     .. Array Arguments ..
 113       DOUBLE PRECISION   D( * ), E( * )
 114 *     ..
 115 *
 116 *  =====================================================================
 117 *
 118 *     .. Parameters ..
 119       DOUBLE PRECISION   ONE, ZERO
 120       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
 121 *     ..
 122 *     .. Local Scalars ..
 123       INTEGER            I
 124       DOUBLE PRECISION   ANORM, SCALE, SUM
 125 *     ..
 126 *     .. External Functions ..
 127       LOGICAL            LSAME, DISNAN
 128       EXTERNAL           LSAME, DISNAN
 129 *     ..
 130 *     .. External Subroutines ..
 131       EXTERNAL           DLASSQ
 132 *     ..
 133 *     .. Intrinsic Functions ..
 134       INTRINSIC          ABS, SQRT
 135 *     ..
 136 *     .. Executable Statements ..
 137 *
 138       IF( N.LE.0 ) THEN
 139          ANORM = ZERO
 140       ELSE IF( LSAME( NORM, 'M' ) ) THEN
 141 *
 142 *        Find max(abs(A(i,j))).
 143 *
 144          ANORM = ABS( D( N ) )
 145          DO 10 I = 1, N - 1
 146             SUM = ABS( D( I ) )
 147             IF( ANORM .LT. SUM .OR. DISNAN( SUM ) ) ANORM = SUM
 148             SUM = ABS( E( I ) )
 149             IF( ANORM .LT. SUM .OR. DISNAN( SUM ) ) ANORM = SUM
 150    10    CONTINUE
 151       ELSE IF( LSAME( NORM, 'O' ) .OR. NORM.EQ.'1' .OR.
 152      $         LSAME( NORM, 'I' ) ) THEN
 153 *
 154 *        Find norm1(A).
 155 *
 156          IF( N.EQ.1 ) THEN
 157             ANORM = ABS( D( 1 ) )
 158          ELSE
 159             ANORM = ABS( D( 1 ) )+ABS( E( 1 ) )
 160             SUM = ABS( E( N-1 ) )+ABS( D( N ) )
 161             IF( ANORM .LT. SUM .OR. DISNAN( SUM ) ) ANORM = SUM
 162             DO 20 I = 2, N - 1
 163                SUM = ABS( D( I ) )+ABS( E( I ) )+ABS( E( I-1 ) )
 164                IF( ANORM .LT. SUM .OR. DISNAN( SUM ) ) ANORM = SUM
 165    20       CONTINUE
 166          END IF
 167       ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
 168 *
 169 *        Find normF(A).
 170 *
 171          SCALE = ZERO
 172          SUM = ONE
 173          IF( N.GT.1 ) THEN
 174             CALL DLASSQ( N-1, E, 1, SCALE, SUM )
 175             SUM = 2*SUM
 176          END IF
 177          CALL DLASSQ( N, D, 1, SCALE, SUM )
 178          ANORM = SCALE*SQRT( SUM )
 179       END IF
 180 *
 181       DLANST = ANORM
 182       RETURN
 183 *
 184 *     End of DLANST
 185 *
 186       END