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