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
187