1 *> \brief \b CLANTR returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a trapezoidal or triangular matrix.
3 * =========== DOCUMENTATION ===========
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
9 *> Download CLANTR + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clantr.f">
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clantr.f">
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clantr.f">
21 * REAL FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A, LDA,
24 * .. Scalar Arguments ..
25 * CHARACTER DIAG, NORM, UPLO
28 * .. Array Arguments ..
39 *> CLANTR returns the value of the one norm, or the Frobenius norm, or
40 *> the infinity norm, or the element of largest absolute value of a
41 *> trapezoidal or triangular matrix A.
47 *> CLANTR = ( max(abs(A(i,j))), NORM = 'M' or 'm'
49 *> ( norm1(A), NORM = '1', 'O' or 'o'
51 *> ( normI(A), NORM = 'I' or 'i'
53 *> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
55 *> where norm1 denotes the one norm of a matrix (maximum column sum),
56 *> normI denotes the infinity norm of a matrix (maximum row sum) and
57 *> normF denotes the Frobenius norm of a matrix (square root of sum of
58 *> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
66 *> NORM is CHARACTER*1
67 *> Specifies the value to be returned in CLANTR as described
73 *> UPLO is CHARACTER*1
74 *> Specifies whether the matrix A is upper or lower trapezoidal.
75 *> = 'U': Upper trapezoidal
76 *> = 'L': Lower trapezoidal
77 *> Note that A is triangular instead of trapezoidal if M = N.
82 *> DIAG is CHARACTER*1
83 *> Specifies whether or not the matrix A has unit diagonal.
84 *> = 'N': Non-unit diagonal
85 *> = 'U': Unit diagonal
91 *> The number of rows of the matrix A. M >= 0, and if
92 *> UPLO = 'U', M <= N. When M = 0, CLANTR is set to zero.
98 *> The number of columns of the matrix A. N >= 0, and if
99 *> UPLO = 'L', N <= M. When N = 0, CLANTR is set to zero.
104 *> A is COMPLEX array, dimension (LDA,N)
105 *> The trapezoidal matrix A (A is triangular if M = N).
106 *> If UPLO = 'U', the leading m by n upper trapezoidal part of
107 *> the array A contains the upper trapezoidal matrix, and the
108 *> strictly lower triangular part of A is not referenced.
109 *> If UPLO = 'L', the leading m by n lower trapezoidal part of
110 *> the array A contains the lower trapezoidal matrix, and the
111 *> strictly upper triangular part of A is not referenced. Note
112 *> that when DIAG = 'U', the diagonal elements of A are not
113 *> referenced and are assumed to be one.
119 *> The leading dimension of the array A. LDA >= max(M,1).
124 *> WORK is REAL array, dimension (MAX(1,LWORK)),
125 *> where LWORK >= M when NORM = 'I'; otherwise, WORK is not
132 *> \author Univ. of Tennessee
133 *> \author Univ. of California Berkeley
134 *> \author Univ. of Colorado Denver
137 *> \date September 2012
139 *> \ingroup complexOTHERauxiliary
141 * =====================================================================
142 REAL FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A, LDA,
145 * -- LAPACK auxiliary routine (version 3.4.2) --
146 * -- LAPACK is a software package provided by Univ. of Tennessee, --
147 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
150 * .. Scalar Arguments ..
151 CHARACTER DIAG, NORM, UPLO
154 * .. Array Arguments ..
159 * =====================================================================
163 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
165 * .. Local Scalars ..
168 REAL SCALE, SUM, VALUE
170 * .. External Functions ..
171 LOGICAL LSAME, SISNAN
172 EXTERNAL LSAME, SISNAN
174 * .. External Subroutines ..
177 * .. Intrinsic Functions ..
178 INTRINSIC ABS, MIN, SQRT
180 * .. Executable Statements ..
182 IF( MIN( M, N ).EQ.0 ) THEN
184 ELSE IF( LSAME( NORM, 'M' ) ) THEN
186 * Find max(abs(A(i,j))).
188 IF( LSAME( DIAG, 'U' ) ) THEN
190 IF( LSAME( UPLO, 'U' ) ) THEN
192 DO 10 I = 1, MIN( M, J-1 )
193 SUM = ABS( A( I, J ) )
194 IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
200 SUM = ABS( A( I, J ) )
201 IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
207 IF( LSAME( UPLO, 'U' ) ) THEN
209 DO 50 I = 1, MIN( M, J )
210 SUM = ABS( A( I, J ) )
211 IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
217 SUM = ABS( A( I, J ) )
218 IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
223 ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
228 UDIAG = LSAME( DIAG, 'U' )
229 IF( LSAME( UPLO, 'U' ) ) THEN
231 IF( ( UDIAG ) .AND. ( J.LE.M ) ) THEN
234 SUM = SUM + ABS( A( I, J ) )
238 DO 100 I = 1, MIN( M, J )
239 SUM = SUM + ABS( A( I, J ) )
242 IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
249 SUM = SUM + ABS( A( I, J ) )
254 SUM = SUM + ABS( A( I, J ) )
257 IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
260 ELSE IF( LSAME( NORM, 'I' ) ) THEN
264 IF( LSAME( UPLO, 'U' ) ) THEN
265 IF( LSAME( DIAG, 'U' ) ) THEN
270 DO 160 I = 1, MIN( M, J-1 )
271 WORK( I ) = WORK( I ) + ABS( A( I, J ) )
279 DO 190 I = 1, MIN( M, J )
280 WORK( I ) = WORK( I ) + ABS( A( I, J ) )
285 IF( LSAME( DIAG, 'U' ) ) THEN
294 WORK( I ) = WORK( I ) + ABS( A( I, J ) )
303 WORK( I ) = WORK( I ) + ABS( A( I, J ) )
311 IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
313 ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
317 IF( LSAME( UPLO, 'U' ) ) THEN
318 IF( LSAME( DIAG, 'U' ) ) THEN
322 CALL CLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, SUM )
328 CALL CLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, SUM )
332 IF( LSAME( DIAG, 'U' ) ) THEN
336 CALL CLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, SCALE,
343 CALL CLASSQ( M-J+1, A( J, J ), 1, SCALE, SUM )
347 VALUE = SCALE*SQRT( SUM )