File:
[local] /
rpl /
lapack /
lapack /
dlantb.f
Revision
1.7:
download - view:
text,
annotated -
select for diffs -
revision graph
Tue Dec 21 13:53:30 2010 UTC (13 years, 4 months ago) by
bertrand
Branches:
MAIN
CVS tags:
rpl-4_1_3,
rpl-4_1_2,
rpl-4_1_1,
rpl-4_1_0,
rpl-4_0_24,
rpl-4_0_22,
rpl-4_0_21,
rpl-4_0_20,
rpl-4_0,
HEAD
Mise à jour de lapack vers la version 3.3.0.
1: DOUBLE PRECISION FUNCTION DLANTB( NORM, UPLO, DIAG, N, K, AB,
2: $ LDAB, WORK )
3: *
4: * -- LAPACK auxiliary routine (version 3.2) --
5: * -- LAPACK is a software package provided by Univ. of Tennessee, --
6: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
7: * November 2006
8: *
9: * .. Scalar Arguments ..
10: CHARACTER DIAG, NORM, UPLO
11: INTEGER K, LDAB, N
12: * ..
13: * .. Array Arguments ..
14: DOUBLE PRECISION AB( LDAB, * ), WORK( * )
15: * ..
16: *
17: * Purpose
18: * =======
19: *
20: * DLANTB returns the value of the one norm, or the Frobenius norm, or
21: * the infinity norm, or the element of largest absolute value of an
22: * n by n triangular band matrix A, with ( k + 1 ) diagonals.
23: *
24: * Description
25: * ===========
26: *
27: * DLANTB returns the value
28: *
29: * DLANTB = ( max(abs(A(i,j))), NORM = 'M' or 'm'
30: * (
31: * ( norm1(A), NORM = '1', 'O' or 'o'
32: * (
33: * ( normI(A), NORM = 'I' or 'i'
34: * (
35: * ( normF(A), NORM = 'F', 'f', 'E' or 'e'
36: *
37: * where norm1 denotes the one norm of a matrix (maximum column sum),
38: * normI denotes the infinity norm of a matrix (maximum row sum) and
39: * normF denotes the Frobenius norm of a matrix (square root of sum of
40: * squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
41: *
42: * Arguments
43: * =========
44: *
45: * NORM (input) CHARACTER*1
46: * Specifies the value to be returned in DLANTB as described
47: * above.
48: *
49: * UPLO (input) CHARACTER*1
50: * Specifies whether the matrix A is upper or lower triangular.
51: * = 'U': Upper triangular
52: * = 'L': Lower triangular
53: *
54: * DIAG (input) CHARACTER*1
55: * Specifies whether or not the matrix A is unit triangular.
56: * = 'N': Non-unit triangular
57: * = 'U': Unit triangular
58: *
59: * N (input) INTEGER
60: * The order of the matrix A. N >= 0. When N = 0, DLANTB is
61: * set to zero.
62: *
63: * K (input) INTEGER
64: * The number of super-diagonals of the matrix A if UPLO = 'U',
65: * or the number of sub-diagonals of the matrix A if UPLO = 'L'.
66: * K >= 0.
67: *
68: * AB (input) DOUBLE PRECISION array, dimension (LDAB,N)
69: * The upper or lower triangular band matrix A, stored in the
70: * first k+1 rows of AB. The j-th column of A is stored
71: * in the j-th column of the array AB as follows:
72: * if UPLO = 'U', AB(k+1+i-j,j) = A(i,j) for max(1,j-k)<=i<=j;
73: * if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+k).
74: * Note that when DIAG = 'U', the elements of the array AB
75: * corresponding to the diagonal elements of the matrix A are
76: * not referenced, but are assumed to be one.
77: *
78: * LDAB (input) INTEGER
79: * The leading dimension of the array AB. LDAB >= K+1.
80: *
81: * WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
82: * where LWORK >= N when NORM = 'I'; otherwise, WORK is not
83: * referenced.
84: *
85: * =====================================================================
86: *
87: * .. Parameters ..
88: DOUBLE PRECISION ONE, ZERO
89: PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
90: * ..
91: * .. Local Scalars ..
92: LOGICAL UDIAG
93: INTEGER I, J, L
94: DOUBLE PRECISION SCALE, SUM, VALUE
95: * ..
96: * .. External Subroutines ..
97: EXTERNAL DLASSQ
98: * ..
99: * .. External Functions ..
100: LOGICAL LSAME
101: EXTERNAL LSAME
102: * ..
103: * .. Intrinsic Functions ..
104: INTRINSIC ABS, MAX, MIN, SQRT
105: * ..
106: * .. Executable Statements ..
107: *
108: IF( N.EQ.0 ) THEN
109: VALUE = ZERO
110: ELSE IF( LSAME( NORM, 'M' ) ) THEN
111: *
112: * Find max(abs(A(i,j))).
113: *
114: IF( LSAME( DIAG, 'U' ) ) THEN
115: VALUE = ONE
116: IF( LSAME( UPLO, 'U' ) ) THEN
117: DO 20 J = 1, N
118: DO 10 I = MAX( K+2-J, 1 ), K
119: VALUE = MAX( VALUE, ABS( AB( I, J ) ) )
120: 10 CONTINUE
121: 20 CONTINUE
122: ELSE
123: DO 40 J = 1, N
124: DO 30 I = 2, MIN( N+1-J, K+1 )
125: VALUE = MAX( VALUE, ABS( AB( I, J ) ) )
126: 30 CONTINUE
127: 40 CONTINUE
128: END IF
129: ELSE
130: VALUE = ZERO
131: IF( LSAME( UPLO, 'U' ) ) THEN
132: DO 60 J = 1, N
133: DO 50 I = MAX( K+2-J, 1 ), K + 1
134: VALUE = MAX( VALUE, ABS( AB( I, J ) ) )
135: 50 CONTINUE
136: 60 CONTINUE
137: ELSE
138: DO 80 J = 1, N
139: DO 70 I = 1, MIN( N+1-J, K+1 )
140: VALUE = MAX( VALUE, ABS( AB( I, J ) ) )
141: 70 CONTINUE
142: 80 CONTINUE
143: END IF
144: END IF
145: ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
146: *
147: * Find norm1(A).
148: *
149: VALUE = ZERO
150: UDIAG = LSAME( DIAG, 'U' )
151: IF( LSAME( UPLO, 'U' ) ) THEN
152: DO 110 J = 1, N
153: IF( UDIAG ) THEN
154: SUM = ONE
155: DO 90 I = MAX( K+2-J, 1 ), K
156: SUM = SUM + ABS( AB( I, J ) )
157: 90 CONTINUE
158: ELSE
159: SUM = ZERO
160: DO 100 I = MAX( K+2-J, 1 ), K + 1
161: SUM = SUM + ABS( AB( I, J ) )
162: 100 CONTINUE
163: END IF
164: VALUE = MAX( VALUE, SUM )
165: 110 CONTINUE
166: ELSE
167: DO 140 J = 1, N
168: IF( UDIAG ) THEN
169: SUM = ONE
170: DO 120 I = 2, MIN( N+1-J, K+1 )
171: SUM = SUM + ABS( AB( I, J ) )
172: 120 CONTINUE
173: ELSE
174: SUM = ZERO
175: DO 130 I = 1, MIN( N+1-J, K+1 )
176: SUM = SUM + ABS( AB( I, J ) )
177: 130 CONTINUE
178: END IF
179: VALUE = MAX( VALUE, SUM )
180: 140 CONTINUE
181: END IF
182: ELSE IF( LSAME( NORM, 'I' ) ) THEN
183: *
184: * Find normI(A).
185: *
186: VALUE = ZERO
187: IF( LSAME( UPLO, 'U' ) ) THEN
188: IF( LSAME( DIAG, 'U' ) ) THEN
189: DO 150 I = 1, N
190: WORK( I ) = ONE
191: 150 CONTINUE
192: DO 170 J = 1, N
193: L = K + 1 - J
194: DO 160 I = MAX( 1, J-K ), J - 1
195: WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) )
196: 160 CONTINUE
197: 170 CONTINUE
198: ELSE
199: DO 180 I = 1, N
200: WORK( I ) = ZERO
201: 180 CONTINUE
202: DO 200 J = 1, N
203: L = K + 1 - J
204: DO 190 I = MAX( 1, J-K ), J
205: WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) )
206: 190 CONTINUE
207: 200 CONTINUE
208: END IF
209: ELSE
210: IF( LSAME( DIAG, 'U' ) ) THEN
211: DO 210 I = 1, N
212: WORK( I ) = ONE
213: 210 CONTINUE
214: DO 230 J = 1, N
215: L = 1 - J
216: DO 220 I = J + 1, MIN( N, J+K )
217: WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) )
218: 220 CONTINUE
219: 230 CONTINUE
220: ELSE
221: DO 240 I = 1, N
222: WORK( I ) = ZERO
223: 240 CONTINUE
224: DO 260 J = 1, N
225: L = 1 - J
226: DO 250 I = J, MIN( N, J+K )
227: WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) )
228: 250 CONTINUE
229: 260 CONTINUE
230: END IF
231: END IF
232: DO 270 I = 1, N
233: VALUE = MAX( VALUE, WORK( I ) )
234: 270 CONTINUE
235: ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
236: *
237: * Find normF(A).
238: *
239: IF( LSAME( UPLO, 'U' ) ) THEN
240: IF( LSAME( DIAG, 'U' ) ) THEN
241: SCALE = ONE
242: SUM = N
243: IF( K.GT.0 ) THEN
244: DO 280 J = 2, N
245: CALL DLASSQ( MIN( J-1, K ),
246: $ AB( MAX( K+2-J, 1 ), J ), 1, SCALE,
247: $ SUM )
248: 280 CONTINUE
249: END IF
250: ELSE
251: SCALE = ZERO
252: SUM = ONE
253: DO 290 J = 1, N
254: CALL DLASSQ( MIN( J, K+1 ), AB( MAX( K+2-J, 1 ), J ),
255: $ 1, SCALE, SUM )
256: 290 CONTINUE
257: END IF
258: ELSE
259: IF( LSAME( DIAG, 'U' ) ) THEN
260: SCALE = ONE
261: SUM = N
262: IF( K.GT.0 ) THEN
263: DO 300 J = 1, N - 1
264: CALL DLASSQ( MIN( N-J, K ), AB( 2, J ), 1, SCALE,
265: $ SUM )
266: 300 CONTINUE
267: END IF
268: ELSE
269: SCALE = ZERO
270: SUM = ONE
271: DO 310 J = 1, N
272: CALL DLASSQ( MIN( N-J+1, K+1 ), AB( 1, J ), 1, SCALE,
273: $ SUM )
274: 310 CONTINUE
275: END IF
276: END IF
277: VALUE = SCALE*SQRT( SUM )
278: END IF
279: *
280: DLANTB = VALUE
281: RETURN
282: *
283: * End of DLANTB
284: *
285: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dlantb.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack