File:
[local] /
rpl /
lapack /
lapack /
dlantr.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 DLANTR( NORM, UPLO, DIAG, M, N, A, LDA,
2: $ 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 LDA, M, N
12: * ..
13: * .. Array Arguments ..
14: DOUBLE PRECISION A( LDA, * ), WORK( * )
15: * ..
16: *
17: * Purpose
18: * =======
19: *
20: * DLANTR returns the value of the one norm, or the Frobenius norm, or
21: * the infinity norm, or the element of largest absolute value of a
22: * trapezoidal or triangular matrix A.
23: *
24: * Description
25: * ===========
26: *
27: * DLANTR returns the value
28: *
29: * DLANTR = ( 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 DLANTR as described
47: * above.
48: *
49: * UPLO (input) CHARACTER*1
50: * Specifies whether the matrix A is upper or lower trapezoidal.
51: * = 'U': Upper trapezoidal
52: * = 'L': Lower trapezoidal
53: * Note that A is triangular instead of trapezoidal if M = N.
54: *
55: * DIAG (input) CHARACTER*1
56: * Specifies whether or not the matrix A has unit diagonal.
57: * = 'N': Non-unit diagonal
58: * = 'U': Unit diagonal
59: *
60: * M (input) INTEGER
61: * The number of rows of the matrix A. M >= 0, and if
62: * UPLO = 'U', M <= N. When M = 0, DLANTR is set to zero.
63: *
64: * N (input) INTEGER
65: * The number of columns of the matrix A. N >= 0, and if
66: * UPLO = 'L', N <= M. When N = 0, DLANTR is set to zero.
67: *
68: * A (input) DOUBLE PRECISION array, dimension (LDA,N)
69: * The trapezoidal matrix A (A is triangular if M = N).
70: * If UPLO = 'U', the leading m by n upper trapezoidal part of
71: * the array A contains the upper trapezoidal matrix, and the
72: * strictly lower triangular part of A is not referenced.
73: * If UPLO = 'L', the leading m by n lower trapezoidal part of
74: * the array A contains the lower trapezoidal matrix, and the
75: * strictly upper triangular part of A is not referenced. Note
76: * that when DIAG = 'U', the diagonal elements of A are not
77: * referenced and are assumed to be one.
78: *
79: * LDA (input) INTEGER
80: * The leading dimension of the array A. LDA >= max(M,1).
81: *
82: * WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
83: * where LWORK >= M 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
95: DOUBLE PRECISION SCALE, SUM, VALUE
96: * ..
97: * .. External Subroutines ..
98: EXTERNAL DLASSQ
99: * ..
100: * .. External Functions ..
101: LOGICAL LSAME
102: EXTERNAL LSAME
103: * ..
104: * .. Intrinsic Functions ..
105: INTRINSIC ABS, MAX, MIN, SQRT
106: * ..
107: * .. Executable Statements ..
108: *
109: IF( MIN( M, 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 = 1, MIN( M, J-1 )
120: VALUE = MAX( VALUE, ABS( A( I, J ) ) )
121: 10 CONTINUE
122: 20 CONTINUE
123: ELSE
124: DO 40 J = 1, N
125: DO 30 I = J + 1, M
126: VALUE = MAX( VALUE, ABS( A( 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 = 1, MIN( M, J )
135: VALUE = MAX( VALUE, ABS( A( I, J ) ) )
136: 50 CONTINUE
137: 60 CONTINUE
138: ELSE
139: DO 80 J = 1, N
140: DO 70 I = J, M
141: VALUE = MAX( VALUE, ABS( A( 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 ) .AND. ( J.LE.M ) ) THEN
155: SUM = ONE
156: DO 90 I = 1, J - 1
157: SUM = SUM + ABS( A( I, J ) )
158: 90 CONTINUE
159: ELSE
160: SUM = ZERO
161: DO 100 I = 1, MIN( M, J )
162: SUM = SUM + ABS( A( 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 = J + 1, M
172: SUM = SUM + ABS( A( I, J ) )
173: 120 CONTINUE
174: ELSE
175: SUM = ZERO
176: DO 130 I = J, M
177: SUM = SUM + ABS( A( 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: IF( LSAME( UPLO, 'U' ) ) THEN
188: IF( LSAME( DIAG, 'U' ) ) THEN
189: DO 150 I = 1, M
190: WORK( I ) = ONE
191: 150 CONTINUE
192: DO 170 J = 1, N
193: DO 160 I = 1, MIN( M, J-1 )
194: WORK( I ) = WORK( I ) + ABS( A( I, J ) )
195: 160 CONTINUE
196: 170 CONTINUE
197: ELSE
198: DO 180 I = 1, M
199: WORK( I ) = ZERO
200: 180 CONTINUE
201: DO 200 J = 1, N
202: DO 190 I = 1, MIN( M, J )
203: WORK( I ) = WORK( I ) + ABS( A( I, J ) )
204: 190 CONTINUE
205: 200 CONTINUE
206: END IF
207: ELSE
208: IF( LSAME( DIAG, 'U' ) ) THEN
209: DO 210 I = 1, N
210: WORK( I ) = ONE
211: 210 CONTINUE
212: DO 220 I = N + 1, M
213: WORK( I ) = ZERO
214: 220 CONTINUE
215: DO 240 J = 1, N
216: DO 230 I = J + 1, M
217: WORK( I ) = WORK( I ) + ABS( A( I, J ) )
218: 230 CONTINUE
219: 240 CONTINUE
220: ELSE
221: DO 250 I = 1, M
222: WORK( I ) = ZERO
223: 250 CONTINUE
224: DO 270 J = 1, N
225: DO 260 I = J, M
226: WORK( I ) = WORK( I ) + ABS( A( I, J ) )
227: 260 CONTINUE
228: 270 CONTINUE
229: END IF
230: END IF
231: VALUE = ZERO
232: DO 280 I = 1, M
233: VALUE = MAX( VALUE, WORK( I ) )
234: 280 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 = MIN( M, N )
243: DO 290 J = 2, N
244: CALL DLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, SUM )
245: 290 CONTINUE
246: ELSE
247: SCALE = ZERO
248: SUM = ONE
249: DO 300 J = 1, N
250: CALL DLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, SUM )
251: 300 CONTINUE
252: END IF
253: ELSE
254: IF( LSAME( DIAG, 'U' ) ) THEN
255: SCALE = ONE
256: SUM = MIN( M, N )
257: DO 310 J = 1, N
258: CALL DLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, SCALE,
259: $ SUM )
260: 310 CONTINUE
261: ELSE
262: SCALE = ZERO
263: SUM = ONE
264: DO 320 J = 1, N
265: CALL DLASSQ( M-J+1, A( J, J ), 1, SCALE, SUM )
266: 320 CONTINUE
267: END IF
268: END IF
269: VALUE = SCALE*SQRT( SUM )
270: END IF
271: *
272: DLANTR = VALUE
273: RETURN
274: *
275: * End of DLANTR
276: *
277: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dlantr.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack