LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
dlantb.f
Go to the documentation of this file.
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 *> \date September 2012
136 *
137 *> \ingroup doubleOTHERauxiliary
138 *
139 * =====================================================================
140  DOUBLE PRECISION FUNCTION dlantb( NORM, UPLO, DIAG, N, K, AB,
141  $ ldab, work )
142 *
143 * -- LAPACK auxiliary routine (version 3.4.2) --
144 * -- LAPACK is a software package provided by Univ. of Tennessee, --
145 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
146 * September 2012
147 *
148 * .. Scalar Arguments ..
149  CHARACTER diag, norm, uplo
150  INTEGER k, ldab, n
151 * ..
152 * .. Array Arguments ..
153  DOUBLE PRECISION ab( ldab, * ), work( * )
154 * ..
155 *
156 * =====================================================================
157 *
158 * .. Parameters ..
159  DOUBLE PRECISION one, zero
160  parameter( one = 1.0d+0, zero = 0.0d+0 )
161 * ..
162 * .. Local Scalars ..
163  LOGICAL udiag
164  INTEGER i, j, l
165  DOUBLE PRECISION scale, sum, value
166 * ..
167 * .. External Subroutines ..
168  EXTERNAL dlassq
169 * ..
170 * .. External Functions ..
171  LOGICAL lsame, disnan
172  EXTERNAL lsame, disnan
173 * ..
174 * .. Intrinsic Functions ..
175  INTRINSIC abs, max, min, sqrt
176 * ..
177 * .. Executable Statements ..
178 *
179  IF( n.EQ.0 ) THEN
180  value = zero
181  ELSE IF( lsame( norm, 'M' ) ) THEN
182 *
183 * Find max(abs(A(i,j))).
184 *
185  IF( lsame( diag, 'U' ) ) THEN
186  value = one
187  IF( lsame( uplo, 'U' ) ) THEN
188  DO 20 j = 1, n
189  DO 10 i = max( k+2-j, 1 ), k
190  sum = abs( ab( i, j ) )
191  IF( value .LT. sum .OR. disnan( sum ) ) value = sum
192  10 continue
193  20 continue
194  ELSE
195  DO 40 j = 1, n
196  DO 30 i = 2, min( n+1-j, k+1 )
197  sum = abs( ab( i, j ) )
198  IF( value .LT. sum .OR. disnan( sum ) ) value = sum
199  30 continue
200  40 continue
201  END IF
202  ELSE
203  value = zero
204  IF( lsame( uplo, 'U' ) ) THEN
205  DO 60 j = 1, n
206  DO 50 i = max( k+2-j, 1 ), k + 1
207  sum = abs( ab( i, j ) )
208  IF( value .LT. sum .OR. disnan( sum ) ) value = sum
209  50 continue
210  60 continue
211  ELSE
212  DO 80 j = 1, n
213  DO 70 i = 1, min( n+1-j, k+1 )
214  sum = abs( ab( i, j ) )
215  IF( value .LT. sum .OR. disnan( sum ) ) value = sum
216  70 continue
217  80 continue
218  END IF
219  END IF
220  ELSE IF( ( lsame( norm, 'O' ) ) .OR. ( norm.EQ.'1' ) ) THEN
221 *
222 * Find norm1(A).
223 *
224  value = zero
225  udiag = lsame( diag, 'U' )
226  IF( lsame( uplo, 'U' ) ) THEN
227  DO 110 j = 1, n
228  IF( udiag ) THEN
229  sum = one
230  DO 90 i = max( k+2-j, 1 ), k
231  sum = sum + abs( ab( i, j ) )
232  90 continue
233  ELSE
234  sum = zero
235  DO 100 i = max( k+2-j, 1 ), k + 1
236  sum = sum + abs( ab( i, j ) )
237  100 continue
238  END IF
239  IF( value .LT. sum .OR. disnan( sum ) ) value = sum
240  110 continue
241  ELSE
242  DO 140 j = 1, n
243  IF( udiag ) THEN
244  sum = one
245  DO 120 i = 2, min( n+1-j, k+1 )
246  sum = sum + abs( ab( i, j ) )
247  120 continue
248  ELSE
249  sum = zero
250  DO 130 i = 1, min( n+1-j, k+1 )
251  sum = sum + abs( ab( i, j ) )
252  130 continue
253  END IF
254  IF( value .LT. sum .OR. disnan( sum ) ) value = sum
255  140 continue
256  END IF
257  ELSE IF( lsame( norm, 'I' ) ) THEN
258 *
259 * Find normI(A).
260 *
261  value = zero
262  IF( lsame( uplo, 'U' ) ) THEN
263  IF( lsame( diag, 'U' ) ) THEN
264  DO 150 i = 1, n
265  work( i ) = one
266  150 continue
267  DO 170 j = 1, n
268  l = k + 1 - j
269  DO 160 i = max( 1, j-k ), j - 1
270  work( i ) = work( i ) + abs( ab( l+i, j ) )
271  160 continue
272  170 continue
273  ELSE
274  DO 180 i = 1, n
275  work( i ) = zero
276  180 continue
277  DO 200 j = 1, n
278  l = k + 1 - j
279  DO 190 i = max( 1, j-k ), j
280  work( i ) = work( i ) + abs( ab( l+i, j ) )
281  190 continue
282  200 continue
283  END IF
284  ELSE
285  IF( lsame( diag, 'U' ) ) THEN
286  DO 210 i = 1, n
287  work( i ) = one
288  210 continue
289  DO 230 j = 1, n
290  l = 1 - j
291  DO 220 i = j + 1, min( n, j+k )
292  work( i ) = work( i ) + abs( ab( l+i, j ) )
293  220 continue
294  230 continue
295  ELSE
296  DO 240 i = 1, n
297  work( i ) = zero
298  240 continue
299  DO 260 j = 1, n
300  l = 1 - j
301  DO 250 i = j, min( n, j+k )
302  work( i ) = work( i ) + abs( ab( l+i, j ) )
303  250 continue
304  260 continue
305  END IF
306  END IF
307  DO 270 i = 1, n
308  sum = work( i )
309  IF( value .LT. sum .OR. disnan( sum ) ) value = sum
310  270 continue
311  ELSE IF( ( lsame( norm, 'F' ) ) .OR. ( lsame( norm, 'E' ) ) ) THEN
312 *
313 * Find normF(A).
314 *
315  IF( lsame( uplo, 'U' ) ) THEN
316  IF( lsame( diag, 'U' ) ) THEN
317  scale = one
318  sum = n
319  IF( k.GT.0 ) THEN
320  DO 280 j = 2, n
321  CALL dlassq( min( j-1, k ),
322  $ ab( max( k+2-j, 1 ), j ), 1, scale,
323  $ sum )
324  280 continue
325  END IF
326  ELSE
327  scale = zero
328  sum = one
329  DO 290 j = 1, n
330  CALL dlassq( min( j, k+1 ), ab( max( k+2-j, 1 ), j ),
331  $ 1, scale, sum )
332  290 continue
333  END IF
334  ELSE
335  IF( lsame( diag, 'U' ) ) THEN
336  scale = one
337  sum = n
338  IF( k.GT.0 ) THEN
339  DO 300 j = 1, n - 1
340  CALL dlassq( min( n-j, k ), ab( 2, j ), 1, scale,
341  $ sum )
342  300 continue
343  END IF
344  ELSE
345  scale = zero
346  sum = one
347  DO 310 j = 1, n
348  CALL dlassq( min( n-j+1, k+1 ), ab( 1, j ), 1, scale,
349  $ sum )
350  310 continue
351  END IF
352  END IF
353  value = scale*sqrt( sum )
354  END IF
355 *
356  dlantb = value
357  return
358 *
359 * End of DLANTB
360 *
361  END