1*> \brief \b CLANSP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric matrix supplied in packed form.
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download CLANSP + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clansp.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clansp.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clansp.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       REAL             FUNCTION CLANSP( NORM, UPLO, N, AP, WORK )
22*
23*       .. Scalar Arguments ..
24*       CHARACTER          NORM, UPLO
25*       INTEGER            N
26*       ..
27*       .. Array Arguments ..
28*       REAL               WORK( * )
29*       COMPLEX            AP( * )
30*       ..
31*
32*
33*> \par Purpose:
34*  =============
35*>
36*> \verbatim
37*>
38*> CLANSP  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,  supplied in packed form.
41*> \endverbatim
42*>
43*> \return CLANSP
44*> \verbatim
45*>
46*>    CLANSP = ( 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 CLANSP 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 supplied.
75*>          = 'U':  Upper triangular part of A is supplied
76*>          = 'L':  Lower triangular part of A is supplied
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, CLANSP is
83*>          set to zero.
84*> \endverbatim
85*>
86*> \param[in] AP
87*> \verbatim
88*>          AP is COMPLEX array, dimension (N*(N+1)/2)
89*>          The upper or lower triangle of the symmetric matrix A, packed
90*>          columnwise in a linear array.  The j-th column of A is stored
91*>          in the array AP as follows:
92*>          if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
93*>          if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
94*> \endverbatim
95*>
96*> \param[out] WORK
97*> \verbatim
98*>          WORK is REAL array, dimension (MAX(1,LWORK)),
99*>          where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
100*>          WORK is not referenced.
101*> \endverbatim
102*
103*  Authors:
104*  ========
105*
106*> \author Univ. of Tennessee
107*> \author Univ. of California Berkeley
108*> \author Univ. of Colorado Denver
109*> \author NAG Ltd.
110*
111*> \date September 2012
112*
113*> \ingroup complexOTHERauxiliary
114*
115*  =====================================================================
116      REAL             FUNCTION CLANSP( NORM, UPLO, N, AP, WORK )
117*
118*  -- LAPACK auxiliary routine (version 3.4.2) --
119*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
120*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
121*     September 2012
122*
123*     .. Scalar Arguments ..
124      CHARACTER          NORM, UPLO
125      INTEGER            N
126*     ..
127*     .. Array Arguments ..
128      REAL               WORK( * )
129      COMPLEX            AP( * )
130*     ..
131*
132* =====================================================================
133*
134*     .. Parameters ..
135      REAL               ONE, ZERO
136      PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
137*     ..
138*     .. Local Scalars ..
139      INTEGER            I, J, K
140      REAL               ABSA, SCALE, SUM, VALUE
141*     ..
142*     .. External Functions ..
143      LOGICAL            LSAME, SISNAN
144      EXTERNAL           LSAME, SISNAN
145*     ..
146*     .. External Subroutines ..
147      EXTERNAL           CLASSQ
148*     ..
149*     .. Intrinsic Functions ..
150      INTRINSIC          ABS, AIMAG, REAL, SQRT
151*     ..
152*     .. Executable Statements ..
153*
154      IF( N.EQ.0 ) THEN
155         VALUE = ZERO
156      ELSE IF( LSAME( NORM, 'M' ) ) THEN
157*
158*        Find max(abs(A(i,j))).
159*
160         VALUE = ZERO
161         IF( LSAME( UPLO, 'U' ) ) THEN
162            K = 1
163            DO 20 J = 1, N
164               DO 10 I = K, K + J - 1
165                  SUM = ABS( AP( I ) )
166                  IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
167   10          CONTINUE
168               K = K + J
169   20       CONTINUE
170         ELSE
171            K = 1
172            DO 40 J = 1, N
173               DO 30 I = K, K + N - J
174                  SUM = ABS( AP( I ) )
175                  IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
176   30          CONTINUE
177               K = K + N - J + 1
178   40       CONTINUE
179         END IF
180      ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR.
181     $         ( NORM.EQ.'1' ) ) THEN
182*
183*        Find normI(A) ( = norm1(A), since A is symmetric).
184*
185         VALUE = ZERO
186         K = 1
187         IF( LSAME( UPLO, 'U' ) ) THEN
188            DO 60 J = 1, N
189               SUM = ZERO
190               DO 50 I = 1, J - 1
191                  ABSA = ABS( AP( K ) )
192                  SUM = SUM + ABSA
193                  WORK( I ) = WORK( I ) + ABSA
194                  K = K + 1
195   50          CONTINUE
196               WORK( J ) = SUM + ABS( AP( K ) )
197               K = K + 1
198   60       CONTINUE
199            DO 70 I = 1, N
200               SUM = WORK( I )
201               IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
202   70       CONTINUE
203         ELSE
204            DO 80 I = 1, N
205               WORK( I ) = ZERO
206   80       CONTINUE
207            DO 100 J = 1, N
208               SUM = WORK( J ) + ABS( AP( K ) )
209               K = K + 1
210               DO 90 I = J + 1, N
211                  ABSA = ABS( AP( K ) )
212                  SUM = SUM + ABSA
213                  WORK( I ) = WORK( I ) + ABSA
214                  K = K + 1
215   90          CONTINUE
216               IF( VALUE .LT. SUM .OR. SISNAN( 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*
223         SCALE = ZERO
224         SUM = ONE
225         K = 2
226         IF( LSAME( UPLO, 'U' ) ) THEN
227            DO 110 J = 2, N
228               CALL CLASSQ( J-1, AP( K ), 1, SCALE, SUM )
229               K = K + J
230  110       CONTINUE
231         ELSE
232            DO 120 J = 1, N - 1
233               CALL CLASSQ( N-J, AP( K ), 1, SCALE, SUM )
234               K = K + N - J + 1
235  120       CONTINUE
236         END IF
237         SUM = 2*SUM
238         K = 1
239         DO 130 I = 1, N
240            IF( REAL( AP( K ) ).NE.ZERO ) THEN
241               ABSA = ABS( REAL( AP( K ) ) )
242               IF( SCALE.LT.ABSA ) THEN
243                  SUM = ONE + SUM*( SCALE / ABSA )**2
244                  SCALE = ABSA
245               ELSE
246                  SUM = SUM + ( ABSA / SCALE )**2
247               END IF
248            END IF
249            IF( AIMAG( AP( K ) ).NE.ZERO ) THEN
250               ABSA = ABS( AIMAG( AP( K ) ) )
251               IF( SCALE.LT.ABSA ) THEN
252                  SUM = ONE + SUM*( SCALE / ABSA )**2
253                  SCALE = ABSA
254               ELSE
255                  SUM = SUM + ( ABSA / SCALE )**2
256               END IF
257            END IF
258            IF( LSAME( UPLO, 'U' ) ) THEN
259               K = K + I + 1
260            ELSE
261               K = K + N - I + 1
262            END IF
263  130    CONTINUE
264         VALUE = SCALE*SQRT( SUM )
265      END IF
266*
267      CLANSP = VALUE
268      RETURN
269*
270*     End of CLANSP
271*
272      END
273