 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 REAL FUNCTION CLANHT( NORM, N, D, E ) 00002 * 00003 * -- LAPACK auxiliary routine (version 3.2) -- 00004 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00005 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00006 * November 2006 00007 * 00008 * .. Scalar Arguments .. 00009 CHARACTER NORM 00010 INTEGER N 00011 * .. 00012 * .. Array Arguments .. 00013 REAL D( * ) 00014 COMPLEX E( * ) 00015 * .. 00016 * 00017 * Purpose 00018 * ======= 00019 * 00020 * CLANHT returns the value of the one norm, or the Frobenius norm, or 00021 * the infinity norm, or the element of largest absolute value of a 00022 * complex Hermitian tridiagonal matrix A. 00023 * 00024 * Description 00025 * =========== 00026 * 00027 * CLANHT returns the value 00028 * 00029 * CLANHT = ( max(abs(A(i,j))), NORM = 'M' or 'm' 00030 * ( 00031 * ( norm1(A), NORM = '1', 'O' or 'o' 00032 * ( 00033 * ( normI(A), NORM = 'I' or 'i' 00034 * ( 00035 * ( normF(A), NORM = 'F', 'f', 'E' or 'e' 00036 * 00037 * where norm1 denotes the one norm of a matrix (maximum column sum), 00038 * normI denotes the infinity norm of a matrix (maximum row sum) and 00039 * normF denotes the Frobenius norm of a matrix (square root of sum of 00040 * squares). Note that max(abs(A(i,j))) is not a consistent matrix norm. 00041 * 00042 * Arguments 00043 * ========= 00044 * 00045 * NORM (input) CHARACTER*1 00046 * Specifies the value to be returned in CLANHT as described 00047 * above. 00048 * 00049 * N (input) INTEGER 00050 * The order of the matrix A. N >= 0. When N = 0, CLANHT is 00051 * set to zero. 00052 * 00053 * D (input) REAL array, dimension (N) 00054 * The diagonal elements of A. 00055 * 00056 * E (input) COMPLEX array, dimension (N-1) 00057 * The (n-1) sub-diagonal or super-diagonal elements of A. 00058 * 00059 * ===================================================================== 00060 * 00061 * .. Parameters .. 00062 REAL ONE, ZERO 00063 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 00064 * .. 00065 * .. Local Scalars .. 00066 INTEGER I 00067 REAL ANORM, SCALE, SUM 00068 * .. 00069 * .. External Functions .. 00070 LOGICAL LSAME 00071 EXTERNAL LSAME 00072 * .. 00073 * .. External Subroutines .. 00074 EXTERNAL CLASSQ, SLASSQ 00075 * .. 00076 * .. Intrinsic Functions .. 00077 INTRINSIC ABS, MAX, SQRT 00078 * .. 00079 * .. Executable Statements .. 00080 * 00081 IF( N.LE.0 ) THEN 00082 ANORM = ZERO 00083 ELSE IF( LSAME( NORM, 'M' ) ) THEN 00084 * 00085 * Find max(abs(A(i,j))). 00086 * 00087 ANORM = ABS( D( N ) ) 00088 DO 10 I = 1, N - 1 00089 ANORM = MAX( ANORM, ABS( D( I ) ) ) 00090 ANORM = MAX( ANORM, ABS( E( I ) ) ) 00091 10 CONTINUE 00092 ELSE IF( LSAME( NORM, 'O' ) .OR. NORM.EQ.'1' .OR. 00093 $ LSAME( NORM, 'I' ) ) THEN 00094 * 00095 * Find norm1(A). 00096 * 00097 IF( N.EQ.1 ) THEN 00098 ANORM = ABS( D( 1 ) ) 00099 ELSE 00100 ANORM = MAX( ABS( D( 1 ) )+ABS( E( 1 ) ), 00101 $ ABS( E( N-1 ) )+ABS( D( N ) ) ) 00102 DO 20 I = 2, N - 1 00103 ANORM = MAX( ANORM, ABS( D( I ) )+ABS( E( I ) )+ 00104 $ ABS( E( I-1 ) ) ) 00105 20 CONTINUE 00106 END IF 00107 ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN 00108 * 00109 * Find normF(A). 00110 * 00111 SCALE = ZERO 00112 SUM = ONE 00113 IF( N.GT.1 ) THEN 00114 CALL CLASSQ( N-1, E, 1, SCALE, SUM ) 00115 SUM = 2*SUM 00116 END IF 00117 CALL SLASSQ( N, D, 1, SCALE, SUM ) 00118 ANORM = SCALE*SQRT( SUM ) 00119 END IF 00120 * 00121 CLANHT = ANORM 00122 RETURN 00123 * 00124 * End of CLANHT 00125 * 00126 END
1.7.3 
