1*> \brief \b ZLANHE 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 matrix.
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download ZLANHE + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlanhe.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlanhe.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlanhe.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       DOUBLE PRECISION FUNCTION ZLANHE( NORM, UPLO, N, A, LDA, WORK )
22*
23*       .. Scalar Arguments ..
24*       CHARACTER          NORM, UPLO
25*       INTEGER            LDA, N
26*       ..
27*       .. Array Arguments ..
28*       DOUBLE PRECISION   WORK( * )
29*       COMPLEX*16         A( LDA, * )
30*       ..
31*
32*
33*> \par Purpose:
34*  =============
35*>
36*> \verbatim
37*>
38*> ZLANHE  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 matrix A.
41*> \endverbatim
42*>
43*> \return ZLANHE
44*> \verbatim
45*>
46*>    ZLANHE = ( 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 ZLANHE as described
67*>          above.
68*> \endverbatim
69*>
70*> \param[in] UPLO
71*> \verbatim
72*>          UPLO is CHARACTER*1
73*>          Specifies whether the upper or lower triangular part of the
74*>          hermitian matrix A is to be referenced.
75*>          = 'U':  Upper triangular part of A is referenced
76*>          = 'L':  Lower triangular part of A is referenced
77*> \endverbatim
78*>
79*> \param[in] N
80*> \verbatim
81*>          N is INTEGER
82*>          The order of the matrix A.  N >= 0.  When N = 0, ZLANHE is
83*>          set to zero.
84*> \endverbatim
85*>
86*> \param[in] A
87*> \verbatim
88*>          A is COMPLEX*16 array, dimension (LDA,N)
89*>          The hermitian matrix A.  If UPLO = 'U', the leading n by n
90*>          upper triangular part of A contains the upper triangular part
91*>          of the matrix A, and the strictly lower triangular part of A
92*>          is not referenced.  If UPLO = 'L', the leading n by n lower
93*>          triangular part of A contains the lower triangular part of
94*>          the matrix A, and the strictly upper triangular part of A is
95*>          not referenced. Note that the imaginary parts of the diagonal
96*>          elements need not be set and are assumed to be zero.
97*> \endverbatim
98*>
99*> \param[in] LDA
100*> \verbatim
101*>          LDA is INTEGER
102*>          The leading dimension of the array A.  LDA >= max(N,1).
103*> \endverbatim
104*>
105*> \param[out] WORK
106*> \verbatim
107*>          WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
108*>          where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
109*>          WORK is not referenced.
110*> \endverbatim
111*
112*  Authors:
113*  ========
114*
115*> \author Univ. of Tennessee
116*> \author Univ. of California Berkeley
117*> \author Univ. of Colorado Denver
118*> \author NAG Ltd.
119*
120*> \ingroup complex16HEauxiliary
121*
122*  =====================================================================
123      DOUBLE PRECISION FUNCTION ZLANHE( NORM, UPLO, N, A, LDA, WORK )
124*
125*  -- LAPACK auxiliary routine --
126*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
127*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
128*
129      IMPLICIT NONE
130*     .. Scalar Arguments ..
131      CHARACTER          NORM, UPLO
132      INTEGER            LDA, N
133*     ..
134*     .. Array Arguments ..
135      DOUBLE PRECISION   WORK( * )
136      COMPLEX*16         A( LDA, * )
137*     ..
138*
139* =====================================================================
140*
141*     .. Parameters ..
142      DOUBLE PRECISION   ONE, ZERO
143      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
144*     ..
145*     .. Local Scalars ..
146      INTEGER            I, J
147      DOUBLE PRECISION   ABSA, SUM, VALUE
148*     ..
149*     .. Local Arrays ..
150      DOUBLE PRECISION   SSQ( 2 ), COLSSQ( 2 )
151*     ..
152*     .. External Functions ..
153      LOGICAL            LSAME, DISNAN
154      EXTERNAL           LSAME, DISNAN
155*     ..
156*     .. External Subroutines ..
157      EXTERNAL           ZLASSQ, DCOMBSSQ
158*     ..
159*     .. Intrinsic Functions ..
160      INTRINSIC          ABS, DBLE, SQRT
161*     ..
162*     .. Executable Statements ..
163*
164      IF( N.EQ.0 ) THEN
165         VALUE = ZERO
166      ELSE IF( LSAME( NORM, 'M' ) ) THEN
167*
168*        Find max(abs(A(i,j))).
169*
170         VALUE = ZERO
171         IF( LSAME( UPLO, 'U' ) ) THEN
172            DO 20 J = 1, N
173               DO 10 I = 1, J - 1
174                  SUM = ABS( A( I, J ) )
175                  IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
176   10          CONTINUE
177               SUM = ABS( DBLE( A( J, J ) ) )
178               IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
179   20       CONTINUE
180         ELSE
181            DO 40 J = 1, N
182               SUM = ABS( DBLE( A( J, J ) ) )
183               IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
184               DO 30 I = J + 1, N
185                  SUM = ABS( A( I, J ) )
186                  IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
187   30          CONTINUE
188   40       CONTINUE
189         END IF
190      ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR.
191     $         ( NORM.EQ.'1' ) ) THEN
192*
193*        Find normI(A) ( = norm1(A), since A is hermitian).
194*
195         VALUE = ZERO
196         IF( LSAME( UPLO, 'U' ) ) THEN
197            DO 60 J = 1, N
198               SUM = ZERO
199               DO 50 I = 1, J - 1
200                  ABSA = ABS( A( I, J ) )
201                  SUM = SUM + ABSA
202                  WORK( I ) = WORK( I ) + ABSA
203   50          CONTINUE
204               WORK( J ) = SUM + ABS( DBLE( A( J, J ) ) )
205   60       CONTINUE
206            DO 70 I = 1, N
207               SUM = WORK( I )
208               IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
209   70       CONTINUE
210         ELSE
211            DO 80 I = 1, N
212               WORK( I ) = ZERO
213   80       CONTINUE
214            DO 100 J = 1, N
215               SUM = WORK( J ) + ABS( DBLE( A( J, J ) ) )
216               DO 90 I = J + 1, N
217                  ABSA = ABS( A( I, J ) )
218                  SUM = SUM + ABSA
219                  WORK( I ) = WORK( I ) + ABSA
220   90          CONTINUE
221               IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
222  100       CONTINUE
223         END IF
224      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
225*
226*        Find normF(A).
227*        SSQ(1) is scale
228*        SSQ(2) is sum-of-squares
229*        For better accuracy, sum each column separately.
230*
231         SSQ( 1 ) = ZERO
232         SSQ( 2 ) = ONE
233*
234*        Sum off-diagonals
235*
236         IF( LSAME( UPLO, 'U' ) ) THEN
237            DO 110 J = 2, N
238               COLSSQ( 1 ) = ZERO
239               COLSSQ( 2 ) = ONE
240               CALL ZLASSQ( J-1, A( 1, J ), 1,
241     $                      COLSSQ( 1 ), COLSSQ( 2 ) )
242               CALL DCOMBSSQ( SSQ, COLSSQ )
243  110       CONTINUE
244         ELSE
245            DO 120 J = 1, N - 1
246               COLSSQ( 1 ) = ZERO
247               COLSSQ( 2 ) = ONE
248               CALL ZLASSQ( N-J, A( J+1, J ), 1,
249     $                      COLSSQ( 1 ), COLSSQ( 2 ) )
250               CALL DCOMBSSQ( SSQ, COLSSQ )
251  120       CONTINUE
252         END IF
253         SSQ( 2 ) = 2*SSQ( 2 )
254*
255*        Sum diagonal
256*
257         DO 130 I = 1, N
258            IF( DBLE( A( I, I ) ).NE.ZERO ) THEN
259               ABSA = ABS( DBLE( A( I, I ) ) )
260               IF( SSQ( 1 ).LT.ABSA ) THEN
261                  SSQ( 2 ) = ONE + SSQ( 2 )*( SSQ( 1 ) / ABSA )**2
262                  SSQ( 1 ) = ABSA
263               ELSE
264                  SSQ( 2 ) = SSQ( 2 ) + ( ABSA / SSQ( 1 ) )**2
265               END IF
266            END IF
267  130    CONTINUE
268         VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) )
269      END IF
270*
271      ZLANHE = VALUE
272      RETURN
273*
274*     End of ZLANHE
275*
276      END
277