1 *> \brief \b CLANTP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a triangular matrix supplied in packed form.
3 * =========== DOCUMENTATION ===========
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
9 *> Download CLANTP + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clantp.f">
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clantp.f">
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clantp.f">
21 * REAL FUNCTION CLANTP( NORM, UPLO, DIAG, N, AP, WORK )
23 * .. Scalar Arguments ..
24 * CHARACTER DIAG, NORM, UPLO
27 * .. Array Arguments ..
38 *> CLANTP returns the value of the one norm, or the Frobenius norm, or
39 *> the infinity norm, or the element of largest absolute value of a
40 *> triangular matrix A, supplied in packed form.
46 *> CLANTP = ( max(abs(A(i,j))), NORM = 'M' or 'm'
48 *> ( norm1(A), NORM = '1', 'O' or 'o'
50 *> ( normI(A), NORM = 'I' or 'i'
52 *> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
54 *> where norm1 denotes the one norm of a matrix (maximum column sum),
55 *> normI denotes the infinity norm of a matrix (maximum row sum) and
56 *> normF denotes the Frobenius norm of a matrix (square root of sum of
57 *> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
65 *> NORM is CHARACTER*1
66 *> Specifies the value to be returned in CLANTP as described
72 *> UPLO is CHARACTER*1
73 *> Specifies whether the matrix A is upper or lower triangular.
74 *> = 'U': Upper triangular
75 *> = 'L': Lower triangular
80 *> DIAG is CHARACTER*1
81 *> Specifies whether or not the matrix A is unit triangular.
82 *> = 'N': Non-unit triangular
83 *> = 'U': Unit triangular
89 *> The order of the matrix A. N >= 0. When N = 0, CLANTP is
95 *> AP is COMPLEX array, dimension (N*(N+1)/2)
96 *> The upper or lower triangular matrix A, packed columnwise in
97 *> a linear array. The j-th column of A is stored in the array
99 *> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
100 *> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
101 *> Note that when DIAG = 'U', the elements of the array AP
102 *> corresponding to the diagonal elements of the matrix A are
103 *> not referenced, but are assumed to be one.
108 *> WORK is REAL array, dimension (MAX(1,LWORK)),
109 *> where LWORK >= N when NORM = 'I'; otherwise, WORK is not
116 *> \author Univ. of Tennessee
117 *> \author Univ. of California Berkeley
118 *> \author Univ. of Colorado Denver
121 *> \date September 2012
123 *> \ingroup complexOTHERauxiliary
125 * =====================================================================
126 REAL FUNCTION CLANTP( NORM, UPLO, DIAG, N, AP, WORK )
128 * -- LAPACK auxiliary routine (version 3.4.2) --
129 * -- LAPACK is a software package provided by Univ. of Tennessee, --
130 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
133 * .. Scalar Arguments ..
134 CHARACTER DIAG, NORM, UPLO
137 * .. Array Arguments ..
142 * =====================================================================
146 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
148 * .. Local Scalars ..
151 REAL SCALE, SUM, VALUE
153 * .. External Functions ..
154 LOGICAL LSAME, SISNAN
155 EXTERNAL LSAME, SISNAN
157 * .. External Subroutines ..
160 * .. Intrinsic Functions ..
163 * .. Executable Statements ..
167 ELSE IF( LSAME( NORM, 'M' ) ) THEN
169 * Find max(abs(A(i,j))).
172 IF( LSAME( DIAG, 'U' ) ) THEN
174 IF( LSAME( UPLO, 'U' ) ) THEN
176 DO 10 I = K, K + J - 2
178 IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
184 DO 30 I = K + 1, K + N - J
186 IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
193 IF( LSAME( UPLO, 'U' ) ) THEN
195 DO 50 I = K, K + J - 1
197 IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
203 DO 70 I = K, K + N - J
205 IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
211 ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
217 UDIAG = LSAME( DIAG, 'U' )
218 IF( LSAME( UPLO, 'U' ) ) THEN
222 DO 90 I = K, K + J - 2
223 SUM = SUM + ABS( AP( I ) )
227 DO 100 I = K, K + J - 1
228 SUM = SUM + ABS( AP( I ) )
232 IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
238 DO 120 I = K + 1, K + N - J
239 SUM = SUM + ABS( AP( I ) )
243 DO 130 I = K, K + N - J
244 SUM = SUM + ABS( AP( I ) )
248 IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
251 ELSE IF( LSAME( NORM, 'I' ) ) THEN
256 IF( LSAME( UPLO, 'U' ) ) THEN
257 IF( LSAME( DIAG, 'U' ) ) THEN
263 WORK( I ) = WORK( I ) + ABS( AP( K ) )
274 WORK( I ) = WORK( I ) + ABS( AP( K ) )
280 IF( LSAME( DIAG, 'U' ) ) THEN
287 WORK( I ) = WORK( I ) + ABS( AP( K ) )
297 WORK( I ) = WORK( I ) + ABS( AP( K ) )
306 IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
308 ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
312 IF( LSAME( UPLO, 'U' ) ) THEN
313 IF( LSAME( DIAG, 'U' ) ) THEN
318 CALL CLASSQ( J-1, AP( K ), 1, SCALE, SUM )
326 CALL CLASSQ( J, AP( K ), 1, SCALE, SUM )
331 IF( LSAME( DIAG, 'U' ) ) THEN
336 CALL CLASSQ( N-J, AP( K ), 1, SCALE, SUM )
344 CALL CLASSQ( N-J+1, AP( K ), 1, SCALE, SUM )
349 VALUE = SCALE*SQRT( SUM )