LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
real function clantr ( character  NORM,
character  UPLO,
character  DIAG,
integer  M,
integer  N,
complex, dimension( lda, * )  A,
integer  LDA,
real, dimension( * )  WORK 
)

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.

Download CLANTR + dependencies [TGZ] [ZIP] [TXT]

Purpose:
 CLANTR  returns the value of the one norm,  or the Frobenius norm, or
 the  infinity norm,  or the  element of  largest absolute value  of a
 trapezoidal or triangular matrix A.
Returns
CLANTR
    CLANTR = ( max(abs(A(i,j))), NORM = 'M' or 'm'
             (
             ( norm1(A),         NORM = '1', 'O' or 'o'
             (
             ( normI(A),         NORM = 'I' or 'i'
             (
             ( normF(A),         NORM = 'F', 'f', 'E' or 'e'

 where  norm1  denotes the  one norm of a matrix (maximum column sum),
 normI  denotes the  infinity norm  of a matrix  (maximum row sum) and
 normF  denotes the  Frobenius norm of a matrix (square root of sum of
 squares).  Note that  max(abs(A(i,j)))  is not a consistent matrix norm.
Parameters
[in]NORM
          NORM is CHARACTER*1
          Specifies the value to be returned in CLANTR as described
          above.
[in]UPLO
          UPLO is CHARACTER*1
          Specifies whether the matrix A is upper or lower trapezoidal.
          = 'U':  Upper trapezoidal
          = 'L':  Lower trapezoidal
          Note that A is triangular instead of trapezoidal if M = N.
[in]DIAG
          DIAG is CHARACTER*1
          Specifies whether or not the matrix A has unit diagonal.
          = 'N':  Non-unit diagonal
          = 'U':  Unit diagonal
[in]M
          M is INTEGER
          The number of rows of the matrix A.  M >= 0, and if
          UPLO = 'U', M <= N.  When M = 0, CLANTR is set to zero.
[in]N
          N is INTEGER
          The number of columns of the matrix A.  N >= 0, and if
          UPLO = 'L', N <= M.  When N = 0, CLANTR is set to zero.
[in]A
          A is COMPLEX array, dimension (LDA,N)
          The trapezoidal matrix A (A is triangular if M = N).
          If UPLO = 'U', the leading m by n upper trapezoidal part of
          the array A contains the upper trapezoidal matrix, and the
          strictly lower triangular part of A is not referenced.
          If UPLO = 'L', the leading m by n lower trapezoidal part of
          the array A contains the lower trapezoidal matrix, and the
          strictly upper triangular part of A is not referenced.  Note
          that when DIAG = 'U', the diagonal elements of A are not
          referenced and are assumed to be one.
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A.  LDA >= max(M,1).
[out]WORK
          WORK is REAL array, dimension (MAX(1,LWORK)),
          where LWORK >= M when NORM = 'I'; otherwise, WORK is not
          referenced.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
September 2012

Definition at line 144 of file clantr.f.

144 *
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..--
148 * September 2012
149 *
150 * .. Scalar Arguments ..
151  CHARACTER diag, norm, uplo
152  INTEGER lda, m, n
153 * ..
154 * .. Array Arguments ..
155  REAL work( * )
156  COMPLEX a( lda, * )
157 * ..
158 *
159 * =====================================================================
160 *
161 * .. Parameters ..
162  REAL one, zero
163  parameter ( one = 1.0e+0, zero = 0.0e+0 )
164 * ..
165 * .. Local Scalars ..
166  LOGICAL udiag
167  INTEGER i, j
168  REAL scale, sum, value
169 * ..
170 * .. External Functions ..
171  LOGICAL lsame, sisnan
172  EXTERNAL lsame, sisnan
173 * ..
174 * .. External Subroutines ..
175  EXTERNAL classq
176 * ..
177 * .. Intrinsic Functions ..
178  INTRINSIC abs, min, sqrt
179 * ..
180 * .. Executable Statements ..
181 *
182  IF( min( m, n ).EQ.0 ) THEN
183  VALUE = zero
184  ELSE IF( lsame( norm, 'M' ) ) THEN
185 *
186 * Find max(abs(A(i,j))).
187 *
188  IF( lsame( diag, 'U' ) ) THEN
189  VALUE = one
190  IF( lsame( uplo, 'U' ) ) THEN
191  DO 20 j = 1, n
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
195  10 CONTINUE
196  20 CONTINUE
197  ELSE
198  DO 40 j = 1, n
199  DO 30 i = j + 1, m
200  sum = abs( a( i, j ) )
201  IF( VALUE .LT. sum .OR. sisnan( sum ) ) VALUE = sum
202  30 CONTINUE
203  40 CONTINUE
204  END IF
205  ELSE
206  VALUE = zero
207  IF( lsame( uplo, 'U' ) ) THEN
208  DO 60 j = 1, n
209  DO 50 i = 1, min( m, j )
210  sum = abs( a( i, j ) )
211  IF( VALUE .LT. sum .OR. sisnan( sum ) ) VALUE = sum
212  50 CONTINUE
213  60 CONTINUE
214  ELSE
215  DO 80 j = 1, n
216  DO 70 i = j, m
217  sum = abs( a( i, j ) )
218  IF( VALUE .LT. sum .OR. sisnan( sum ) ) VALUE = sum
219  70 CONTINUE
220  80 CONTINUE
221  END IF
222  END IF
223  ELSE IF( ( lsame( norm, 'O' ) ) .OR. ( norm.EQ.'1' ) ) THEN
224 *
225 * Find norm1(A).
226 *
227  VALUE = zero
228  udiag = lsame( diag, 'U' )
229  IF( lsame( uplo, 'U' ) ) THEN
230  DO 110 j = 1, n
231  IF( ( udiag ) .AND. ( j.LE.m ) ) THEN
232  sum = one
233  DO 90 i = 1, j - 1
234  sum = sum + abs( a( i, j ) )
235  90 CONTINUE
236  ELSE
237  sum = zero
238  DO 100 i = 1, min( m, j )
239  sum = sum + abs( a( i, j ) )
240  100 CONTINUE
241  END IF
242  IF( VALUE .LT. sum .OR. sisnan( sum ) ) VALUE = sum
243  110 CONTINUE
244  ELSE
245  DO 140 j = 1, n
246  IF( udiag ) THEN
247  sum = one
248  DO 120 i = j + 1, m
249  sum = sum + abs( a( i, j ) )
250  120 CONTINUE
251  ELSE
252  sum = zero
253  DO 130 i = j, m
254  sum = sum + abs( a( i, j ) )
255  130 CONTINUE
256  END IF
257  IF( VALUE .LT. sum .OR. sisnan( sum ) ) VALUE = sum
258  140 CONTINUE
259  END IF
260  ELSE IF( lsame( norm, 'I' ) ) THEN
261 *
262 * Find normI(A).
263 *
264  IF( lsame( uplo, 'U' ) ) THEN
265  IF( lsame( diag, 'U' ) ) THEN
266  DO 150 i = 1, m
267  work( i ) = one
268  150 CONTINUE
269  DO 170 j = 1, n
270  DO 160 i = 1, min( m, j-1 )
271  work( i ) = work( i ) + abs( a( i, j ) )
272  160 CONTINUE
273  170 CONTINUE
274  ELSE
275  DO 180 i = 1, m
276  work( i ) = zero
277  180 CONTINUE
278  DO 200 j = 1, n
279  DO 190 i = 1, min( m, j )
280  work( i ) = work( i ) + abs( a( i, j ) )
281  190 CONTINUE
282  200 CONTINUE
283  END IF
284  ELSE
285  IF( lsame( diag, 'U' ) ) THEN
286  DO 210 i = 1, n
287  work( i ) = one
288  210 CONTINUE
289  DO 220 i = n + 1, m
290  work( i ) = zero
291  220 CONTINUE
292  DO 240 j = 1, n
293  DO 230 i = j + 1, m
294  work( i ) = work( i ) + abs( a( i, j ) )
295  230 CONTINUE
296  240 CONTINUE
297  ELSE
298  DO 250 i = 1, m
299  work( i ) = zero
300  250 CONTINUE
301  DO 270 j = 1, n
302  DO 260 i = j, m
303  work( i ) = work( i ) + abs( a( i, j ) )
304  260 CONTINUE
305  270 CONTINUE
306  END IF
307  END IF
308  VALUE = zero
309  DO 280 i = 1, m
310  sum = work( i )
311  IF( VALUE .LT. sum .OR. sisnan( sum ) ) VALUE = sum
312  280 CONTINUE
313  ELSE IF( ( lsame( norm, 'F' ) ) .OR. ( lsame( norm, 'E' ) ) ) THEN
314 *
315 * Find normF(A).
316 *
317  IF( lsame( uplo, 'U' ) ) THEN
318  IF( lsame( diag, 'U' ) ) THEN
319  scale = one
320  sum = min( m, n )
321  DO 290 j = 2, n
322  CALL classq( min( m, j-1 ), a( 1, j ), 1, scale, sum )
323  290 CONTINUE
324  ELSE
325  scale = zero
326  sum = one
327  DO 300 j = 1, n
328  CALL classq( min( m, j ), a( 1, j ), 1, scale, sum )
329  300 CONTINUE
330  END IF
331  ELSE
332  IF( lsame( diag, 'U' ) ) THEN
333  scale = one
334  sum = min( m, n )
335  DO 310 j = 1, n
336  CALL classq( m-j, a( min( m, j+1 ), j ), 1, scale,
337  $ sum )
338  310 CONTINUE
339  ELSE
340  scale = zero
341  sum = one
342  DO 320 j = 1, n
343  CALL classq( m-j+1, a( j, j ), 1, scale, sum )
344  320 CONTINUE
345  END IF
346  END IF
347  VALUE = scale*sqrt( sum )
348  END IF
349 *
350  clantr = VALUE
351  RETURN
352 *
353 * End of CLANTR
354 *
logical function sisnan(SIN)
SISNAN tests input for NaN.
Definition: sisnan.f:61
subroutine classq(N, X, INCX, SCALE, SUMSQ)
CLASSQ updates a sum of squares represented in scaled form.
Definition: classq.f:108
real function clantr(NORM, UPLO, DIAG, M, N, A, LDA, WORK)
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.
Definition: clantr.f:144
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55

Here is the call graph for this function: