1*> \brief \b DLANTB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a triangular 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 DLANTB + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlantb.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlantb.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlantb.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       DOUBLE PRECISION FUNCTION DLANTB( NORM, UPLO, DIAG, N, K, AB,
22*                        LDAB, WORK )
23*
24*       .. Scalar Arguments ..
25*       CHARACTER          DIAG, NORM, UPLO
26*       INTEGER            K, LDAB, N
27*       ..
28*       .. Array Arguments ..
29*       DOUBLE PRECISION   AB( LDAB, * ), WORK( * )
30*       ..
31*
32*
33*> \par Purpose:
34*  =============
35*>
36*> \verbatim
37*>
38*> DLANTB  returns the value of the one norm,  or the Frobenius norm, or
39*> the  infinity norm,  or the element of  largest absolute value  of an
40*> n by n triangular band matrix A,  with ( k + 1 ) diagonals.
41*> \endverbatim
42*>
43*> \return DLANTB
44*> \verbatim
45*>
46*>    DLANTB = ( 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 DLANTB as described
67*>          above.
68*> \endverbatim
69*>
70*> \param[in] UPLO
71*> \verbatim
72*>          UPLO is CHARACTER*1
73*>          Specifies whether the matrix A is upper or lower triangular.
74*>          = 'U':  Upper triangular
75*>          = 'L':  Lower triangular
76*> \endverbatim
77*>
78*> \param[in] DIAG
79*> \verbatim
80*>          DIAG is CHARACTER*1
81*>          Specifies whether or not the matrix A is unit triangular.
82*>          = 'N':  Non-unit triangular
83*>          = 'U':  Unit triangular
84*> \endverbatim
85*>
86*> \param[in] N
87*> \verbatim
88*>          N is INTEGER
89*>          The order of the matrix A.  N >= 0.  When N = 0, DLANTB is
90*>          set to zero.
91*> \endverbatim
92*>
93*> \param[in] K
94*> \verbatim
95*>          K is INTEGER
96*>          The number of super-diagonals of the matrix A if UPLO = 'U',
97*>          or the number of sub-diagonals of the matrix A if UPLO = 'L'.
98*>          K >= 0.
99*> \endverbatim
100*>
101*> \param[in] AB
102*> \verbatim
103*>          AB is DOUBLE PRECISION array, dimension (LDAB,N)
104*>          The upper or lower triangular band matrix A, stored in the
105*>          first k+1 rows of AB.  The j-th column of A is stored
106*>          in the j-th column of the array AB as follows:
107*>          if UPLO = 'U', AB(k+1+i-j,j) = A(i,j) for max(1,j-k)<=i<=j;
108*>          if UPLO = 'L', AB(1+i-j,j)   = A(i,j) for j<=i<=min(n,j+k).
109*>          Note that when DIAG = 'U', the elements of the array AB
110*>          corresponding to the diagonal elements of the matrix A are
111*>          not referenced, but are assumed to be one.
112*> \endverbatim
113*>
114*> \param[in] LDAB
115*> \verbatim
116*>          LDAB is INTEGER
117*>          The leading dimension of the array AB.  LDAB >= K+1.
118*> \endverbatim
119*>
120*> \param[out] WORK
121*> \verbatim
122*>          WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
123*>          where LWORK >= N when NORM = 'I'; otherwise, WORK is not
124*>          referenced.
125*> \endverbatim
126*
127*  Authors:
128*  ========
129*
130*> \author Univ. of Tennessee
131*> \author Univ. of California Berkeley
132*> \author Univ. of Colorado Denver
133*> \author NAG Ltd.
134*
135*> \ingroup doubleOTHERauxiliary
136*
137*  =====================================================================
138      DOUBLE PRECISION FUNCTION DLANTB( NORM, UPLO, DIAG, N, K, AB,
139     $                 LDAB, WORK )
140*
141*  -- LAPACK auxiliary routine --
142*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
143*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
144*
145      IMPLICIT NONE
146*     .. Scalar Arguments ..
147      CHARACTER          DIAG, NORM, UPLO
148      INTEGER            K, LDAB, N
149*     ..
150*     .. Array Arguments ..
151      DOUBLE PRECISION   AB( LDAB, * ), WORK( * )
152*     ..
153*
154* =====================================================================
155*
156*     .. Parameters ..
157      DOUBLE PRECISION   ONE, ZERO
158      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
159*     ..
160*     .. Local Scalars ..
161      LOGICAL            UDIAG
162      INTEGER            I, J, L
163      DOUBLE PRECISION   SUM, VALUE
164*     ..
165*     .. Local Arrays ..
166      DOUBLE PRECISION   SSQ( 2 ), COLSSQ( 2 )
167*     ..
168*     .. External Functions ..
169      LOGICAL            LSAME, DISNAN
170      EXTERNAL           LSAME, DISNAN
171*     ..
172*     .. External Subroutines ..
173      EXTERNAL           DLASSQ, DCOMBSSQ
174*     ..
175*     .. Intrinsic Functions ..
176      INTRINSIC          ABS, MAX, MIN, SQRT
177*     ..
178*     .. Executable Statements ..
179*
180      IF( N.EQ.0 ) THEN
181         VALUE = ZERO
182      ELSE IF( LSAME( NORM, 'M' ) ) THEN
183*
184*        Find max(abs(A(i,j))).
185*
186         IF( LSAME( DIAG, 'U' ) ) THEN
187            VALUE = ONE
188            IF( LSAME( UPLO, 'U' ) ) THEN
189               DO 20 J = 1, N
190                  DO 10 I = MAX( K+2-J, 1 ), K
191                     SUM = ABS( AB( I, J ) )
192                     IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
193   10             CONTINUE
194   20          CONTINUE
195            ELSE
196               DO 40 J = 1, N
197                  DO 30 I = 2, MIN( N+1-J, K+1 )
198                     SUM = ABS( AB( I, J ) )
199                     IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
200   30             CONTINUE
201   40          CONTINUE
202            END IF
203         ELSE
204            VALUE = ZERO
205            IF( LSAME( UPLO, 'U' ) ) THEN
206               DO 60 J = 1, N
207                  DO 50 I = MAX( K+2-J, 1 ), K + 1
208                     SUM = ABS( AB( I, J ) )
209                     IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
210   50             CONTINUE
211   60          CONTINUE
212            ELSE
213               DO 80 J = 1, N
214                  DO 70 I = 1, MIN( N+1-J, K+1 )
215                     SUM = ABS( AB( I, J ) )
216                     IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
217   70             CONTINUE
218   80          CONTINUE
219            END IF
220         END IF
221      ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
222*
223*        Find norm1(A).
224*
225         VALUE = ZERO
226         UDIAG = LSAME( DIAG, 'U' )
227         IF( LSAME( UPLO, 'U' ) ) THEN
228            DO 110 J = 1, N
229               IF( UDIAG ) THEN
230                  SUM = ONE
231                  DO 90 I = MAX( K+2-J, 1 ), K
232                     SUM = SUM + ABS( AB( I, J ) )
233   90             CONTINUE
234               ELSE
235                  SUM = ZERO
236                  DO 100 I = MAX( K+2-J, 1 ), K + 1
237                     SUM = SUM + ABS( AB( I, J ) )
238  100             CONTINUE
239               END IF
240               IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
241  110       CONTINUE
242         ELSE
243            DO 140 J = 1, N
244               IF( UDIAG ) THEN
245                  SUM = ONE
246                  DO 120 I = 2, MIN( N+1-J, K+1 )
247                     SUM = SUM + ABS( AB( I, J ) )
248  120             CONTINUE
249               ELSE
250                  SUM = ZERO
251                  DO 130 I = 1, MIN( N+1-J, K+1 )
252                     SUM = SUM + ABS( AB( I, J ) )
253  130             CONTINUE
254               END IF
255               IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
256  140       CONTINUE
257         END IF
258      ELSE IF( LSAME( NORM, 'I' ) ) THEN
259*
260*        Find normI(A).
261*
262         VALUE = ZERO
263         IF( LSAME( UPLO, 'U' ) ) THEN
264            IF( LSAME( DIAG, 'U' ) ) THEN
265               DO 150 I = 1, N
266                  WORK( I ) = ONE
267  150          CONTINUE
268               DO 170 J = 1, N
269                  L = K + 1 - J
270                  DO 160 I = MAX( 1, J-K ), J - 1
271                     WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) )
272  160             CONTINUE
273  170          CONTINUE
274            ELSE
275               DO 180 I = 1, N
276                  WORK( I ) = ZERO
277  180          CONTINUE
278               DO 200 J = 1, N
279                  L = K + 1 - J
280                  DO 190 I = MAX( 1, J-K ), J
281                     WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) )
282  190             CONTINUE
283  200          CONTINUE
284            END IF
285         ELSE
286            IF( LSAME( DIAG, 'U' ) ) THEN
287               DO 210 I = 1, N
288                  WORK( I ) = ONE
289  210          CONTINUE
290               DO 230 J = 1, N
291                  L = 1 - J
292                  DO 220 I = J + 1, MIN( N, J+K )
293                     WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) )
294  220             CONTINUE
295  230          CONTINUE
296            ELSE
297               DO 240 I = 1, N
298                  WORK( I ) = ZERO
299  240          CONTINUE
300               DO 260 J = 1, N
301                  L = 1 - J
302                  DO 250 I = J, MIN( N, J+K )
303                     WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) )
304  250             CONTINUE
305  260          CONTINUE
306            END IF
307         END IF
308         DO 270 I = 1, N
309            SUM = WORK( I )
310            IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
311  270    CONTINUE
312      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
313*
314*        Find normF(A).
315*        SSQ(1) is scale
316*        SSQ(2) is sum-of-squares
317*        For better accuracy, sum each column separately.
318*
319         IF( LSAME( UPLO, 'U' ) ) THEN
320            IF( LSAME( DIAG, 'U' ) ) THEN
321               SSQ( 1 ) = ONE
322               SSQ( 2 ) = N
323               IF( K.GT.0 ) THEN
324                  DO 280 J = 2, N
325                     COLSSQ( 1 ) = ZERO
326                     COLSSQ( 2 ) = ONE
327                     CALL DLASSQ( MIN( J-1, K ),
328     $                            AB( MAX( K+2-J, 1 ), J ), 1,
329     $                            COLSSQ( 1 ), COLSSQ( 2 ) )
330                     CALL DCOMBSSQ( SSQ, COLSSQ )
331  280             CONTINUE
332               END IF
333            ELSE
334               SSQ( 1 ) = ZERO
335               SSQ( 2 ) = ONE
336               DO 290 J = 1, N
337                  COLSSQ( 1 ) = ZERO
338                  COLSSQ( 2 ) = ONE
339                  CALL DLASSQ( MIN( J, K+1 ), AB( MAX( K+2-J, 1 ), J ),
340     $                         1, COLSSQ( 1 ), COLSSQ( 2 ) )
341                  CALL DCOMBSSQ( SSQ, COLSSQ )
342  290          CONTINUE
343            END IF
344         ELSE
345            IF( LSAME( DIAG, 'U' ) ) THEN
346               SSQ( 1 ) = ONE
347               SSQ( 2 ) = N
348               IF( K.GT.0 ) THEN
349                  DO 300 J = 1, N - 1
350                     COLSSQ( 1 ) = ZERO
351                     COLSSQ( 2 ) = ONE
352                     CALL DLASSQ( MIN( N-J, K ), AB( 2, J ), 1,
353     $                            COLSSQ( 1 ), COLSSQ( 2 ) )
354                     CALL DCOMBSSQ( SSQ, COLSSQ )
355  300             CONTINUE
356               END IF
357            ELSE
358               SSQ( 1 ) = ZERO
359               SSQ( 2 ) = ONE
360               DO 310 J = 1, N
361                  COLSSQ( 1 ) = ZERO
362                  COLSSQ( 2 ) = ONE
363                  CALL DLASSQ( MIN( N-J+1, K+1 ), AB( 1, J ), 1,
364     $                         COLSSQ( 1 ), COLSSQ( 2 ) )
365                  CALL DCOMBSSQ( SSQ, COLSSQ )
366  310          CONTINUE
367            END IF
368         END IF
369         VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) )
370      END IF
371*
372      DLANTB = VALUE
373      RETURN
374*
375*     End of DLANTB
376*
377      END
378