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