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