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