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