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