1*> \brief \b ZLANSY 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 symmetric matrix.
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download ZLANSY + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlansy.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlansy.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlansy.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       DOUBLE PRECISION FUNCTION ZLANSY( 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*> ZLANSY  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 symmetric matrix A.
41*> \endverbatim
42*>
43*> \return ZLANSY
44*> \verbatim
45*>
46*>    ZLANSY = ( 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 ZLANSY 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*>          symmetric 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, ZLANSY 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 symmetric 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.
96*> \endverbatim
97*>
98*> \param[in] LDA
99*> \verbatim
100*>          LDA is INTEGER
101*>          The leading dimension of the array A.  LDA >= max(N,1).
102*> \endverbatim
103*>
104*> \param[out] WORK
105*> \verbatim
106*>          WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
107*>          where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
108*>          WORK is not referenced.
109*> \endverbatim
110*
111*  Authors:
112*  ========
113*
114*> \author Univ. of Tennessee
115*> \author Univ. of California Berkeley
116*> \author Univ. of Colorado Denver
117*> \author NAG Ltd.
118*
119*> \ingroup complex16SYauxiliary
120*
121*  =====================================================================
122      DOUBLE PRECISION FUNCTION ZLANSY( NORM, UPLO, N, A, LDA, WORK )
123*
124*  -- LAPACK auxiliary routine --
125*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
126*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
127*
128      IMPLICIT NONE
129*     .. Scalar Arguments ..
130      CHARACTER          NORM, UPLO
131      INTEGER            LDA, N
132*     ..
133*     .. Array Arguments ..
134      DOUBLE PRECISION   WORK( * )
135      COMPLEX*16         A( LDA, * )
136*     ..
137*
138* =====================================================================
139*
140*     .. Parameters ..
141      DOUBLE PRECISION   ONE, ZERO
142      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
143*     ..
144*     .. Local Scalars ..
145      INTEGER            I, J
146      DOUBLE PRECISION   ABSA, SUM, VALUE
147*     ..
148*     .. Local Arrays ..
149      DOUBLE PRECISION   SSQ( 2 ), COLSSQ( 2 )
150*     ..
151*     .. External Functions ..
152      LOGICAL            LSAME, DISNAN
153      EXTERNAL           LSAME, DISNAN
154*     ..
155*     .. External Subroutines ..
156      EXTERNAL           ZLASSQ, DCOMBSSQ
157*     ..
158*     .. Intrinsic Functions ..
159      INTRINSIC          ABS, SQRT
160*     ..
161*     .. Executable Statements ..
162*
163      IF( N.EQ.0 ) THEN
164         VALUE = ZERO
165      ELSE IF( LSAME( NORM, 'M' ) ) THEN
166*
167*        Find max(abs(A(i,j))).
168*
169         VALUE = ZERO
170         IF( LSAME( UPLO, 'U' ) ) THEN
171            DO 20 J = 1, N
172               DO 10 I = 1, J
173                  SUM = ABS( A( I, J ) )
174                  IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
175   10          CONTINUE
176   20       CONTINUE
177         ELSE
178            DO 40 J = 1, N
179               DO 30 I = J, N
180                  SUM = ABS( A( I, J ) )
181                  IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
182   30          CONTINUE
183   40       CONTINUE
184         END IF
185      ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR.
186     $         ( NORM.EQ.'1' ) ) THEN
187*
188*        Find normI(A) ( = norm1(A), since A is symmetric).
189*
190         VALUE = ZERO
191         IF( LSAME( UPLO, 'U' ) ) THEN
192            DO 60 J = 1, N
193               SUM = ZERO
194               DO 50 I = 1, J - 1
195                  ABSA = ABS( A( I, J ) )
196                  SUM = SUM + ABSA
197                  WORK( I ) = WORK( I ) + ABSA
198   50          CONTINUE
199               WORK( J ) = SUM + ABS( A( J, J ) )
200   60       CONTINUE
201            DO 70 I = 1, N
202               SUM = WORK( I )
203               IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
204   70       CONTINUE
205         ELSE
206            DO 80 I = 1, N
207               WORK( I ) = ZERO
208   80       CONTINUE
209            DO 100 J = 1, N
210               SUM = WORK( J ) + ABS( A( J, J ) )
211               DO 90 I = J + 1, N
212                  ABSA = ABS( A( I, J ) )
213                  SUM = SUM + ABSA
214                  WORK( I ) = WORK( I ) + ABSA
215   90          CONTINUE
216               IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
217  100       CONTINUE
218         END IF
219      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
220*
221*        Find normF(A).
222*        SSQ(1) is scale
223*        SSQ(2) is sum-of-squares
224*        For better accuracy, sum each column separately.
225*
226         SSQ( 1 ) = ZERO
227         SSQ( 2 ) = ONE
228*
229*        Sum off-diagonals
230*
231         IF( LSAME( UPLO, 'U' ) ) THEN
232            DO 110 J = 2, N
233               COLSSQ( 1 ) = ZERO
234               COLSSQ( 2 ) = ONE
235               CALL ZLASSQ( J-1, A( 1, J ), 1, COLSSQ(1), COLSSQ(2) )
236               CALL DCOMBSSQ( SSQ, COLSSQ )
237  110       CONTINUE
238         ELSE
239            DO 120 J = 1, N - 1
240               COLSSQ( 1 ) = ZERO
241               COLSSQ( 2 ) = ONE
242               CALL ZLASSQ( N-J, A( J+1, J ), 1, COLSSQ(1), COLSSQ(2) )
243               CALL DCOMBSSQ( SSQ, COLSSQ )
244  120       CONTINUE
245         END IF
246         SSQ( 2 ) = 2*SSQ( 2 )
247*
248*        Sum diagonal
249*
250         COLSSQ( 1 ) = ZERO
251         COLSSQ( 2 ) = ONE
252         CALL ZLASSQ( N, A, LDA+1, COLSSQ( 1 ), COLSSQ( 2 ) )
253         CALL DCOMBSSQ( SSQ, COLSSQ )
254         VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) )
255      END IF
256*
257      ZLANSY = VALUE
258      RETURN
259*
260*     End of ZLANSY
261*
262      END
263