|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 REAL FUNCTION SLANGT( NORM, N, DL, D, DU ) 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( * ), DL( * ), DU( * ) 00014 * .. 00015 * 00016 * Purpose 00017 * ======= 00018 * 00019 * SLANGT 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 tridiagonal matrix A. 00022 * 00023 * Description 00024 * =========== 00025 * 00026 * SLANGT returns the value 00027 * 00028 * SLANGT = ( 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 SLANGT as described 00046 * above. 00047 * 00048 * N (input) INTEGER 00049 * The order of the matrix A. N >= 0. When N = 0, SLANGT is 00050 * set to zero. 00051 * 00052 * DL (input) REAL array, dimension (N-1) 00053 * The (n-1) sub-diagonal elements of A. 00054 * 00055 * D (input) REAL array, dimension (N) 00056 * The diagonal elements of A. 00057 * 00058 * DU (input) REAL array, dimension (N-1) 00059 * The (n-1) super-diagonal elements of A. 00060 * 00061 * ===================================================================== 00062 * 00063 * .. Parameters .. 00064 REAL ONE, ZERO 00065 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 00066 * .. 00067 * .. Local Scalars .. 00068 INTEGER I 00069 REAL ANORM, SCALE, SUM 00070 * .. 00071 * .. External Functions .. 00072 LOGICAL LSAME 00073 EXTERNAL LSAME 00074 * .. 00075 * .. External Subroutines .. 00076 EXTERNAL SLASSQ 00077 * .. 00078 * .. Intrinsic Functions .. 00079 INTRINSIC ABS, MAX, SQRT 00080 * .. 00081 * .. Executable Statements .. 00082 * 00083 IF( N.LE.0 ) THEN 00084 ANORM = ZERO 00085 ELSE IF( LSAME( NORM, 'M' ) ) THEN 00086 * 00087 * Find max(abs(A(i,j))). 00088 * 00089 ANORM = ABS( D( N ) ) 00090 DO 10 I = 1, N - 1 00091 ANORM = MAX( ANORM, ABS( DL( I ) ) ) 00092 ANORM = MAX( ANORM, ABS( D( I ) ) ) 00093 ANORM = MAX( ANORM, ABS( DU( I ) ) ) 00094 10 CONTINUE 00095 ELSE IF( LSAME( NORM, 'O' ) .OR. NORM.EQ.'1' ) THEN 00096 * 00097 * Find norm1(A). 00098 * 00099 IF( N.EQ.1 ) THEN 00100 ANORM = ABS( D( 1 ) ) 00101 ELSE 00102 ANORM = MAX( ABS( D( 1 ) )+ABS( DL( 1 ) ), 00103 $ ABS( D( N ) )+ABS( DU( N-1 ) ) ) 00104 DO 20 I = 2, N - 1 00105 ANORM = MAX( ANORM, ABS( D( I ) )+ABS( DL( I ) )+ 00106 $ ABS( DU( I-1 ) ) ) 00107 20 CONTINUE 00108 END IF 00109 ELSE IF( LSAME( NORM, 'I' ) ) THEN 00110 * 00111 * Find normI(A). 00112 * 00113 IF( N.EQ.1 ) THEN 00114 ANORM = ABS( D( 1 ) ) 00115 ELSE 00116 ANORM = MAX( ABS( D( 1 ) )+ABS( DU( 1 ) ), 00117 $ ABS( D( N ) )+ABS( DL( N-1 ) ) ) 00118 DO 30 I = 2, N - 1 00119 ANORM = MAX( ANORM, ABS( D( I ) )+ABS( DU( I ) )+ 00120 $ ABS( DL( I-1 ) ) ) 00121 30 CONTINUE 00122 END IF 00123 ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN 00124 * 00125 * Find normF(A). 00126 * 00127 SCALE = ZERO 00128 SUM = ONE 00129 CALL SLASSQ( N, D, 1, SCALE, SUM ) 00130 IF( N.GT.1 ) THEN 00131 CALL SLASSQ( N-1, DL, 1, SCALE, SUM ) 00132 CALL SLASSQ( N-1, DU, 1, SCALE, SUM ) 00133 END IF 00134 ANORM = SCALE*SQRT( SUM ) 00135 END IF 00136 * 00137 SLANGT = ANORM 00138 RETURN 00139 * 00140 * End of SLANGT 00141 * 00142 END
1.7.3 
