LAPACK 3.3.0
|
00001 REAL FUNCTION SLANGB( NORM, N, KL, KU, AB, LDAB, 00002 $ WORK ) 00003 * 00004 * -- LAPACK auxiliary routine (version 3.2) -- 00005 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00006 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00007 * November 2006 00008 * 00009 * .. Scalar Arguments .. 00010 CHARACTER NORM 00011 INTEGER KL, KU, LDAB, N 00012 * .. 00013 * .. Array Arguments .. 00014 REAL AB( LDAB, * ), WORK( * ) 00015 * .. 00016 * 00017 * Purpose 00018 * ======= 00019 * 00020 * SLANGB returns the value of the one norm, or the Frobenius norm, or 00021 * the infinity norm, or the element of largest absolute value of an 00022 * n by n band matrix A, with kl sub-diagonals and ku super-diagonals. 00023 * 00024 * Description 00025 * =========== 00026 * 00027 * SLANGB returns the value 00028 * 00029 * SLANGB = ( 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 SLANGB as described 00047 * above. 00048 * 00049 * N (input) INTEGER 00050 * The order of the matrix A. N >= 0. When N = 0, SLANGB is 00051 * set to zero. 00052 * 00053 * KL (input) INTEGER 00054 * The number of sub-diagonals of the matrix A. KL >= 0. 00055 * 00056 * KU (input) INTEGER 00057 * The number of super-diagonals of the matrix A. KU >= 0. 00058 * 00059 * AB (input) REAL array, dimension (LDAB,N) 00060 * The band matrix A, stored in rows 1 to KL+KU+1. The j-th 00061 * column of A is stored in the j-th column of the array AB as 00062 * follows: 00063 * AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(n,j+kl). 00064 * 00065 * LDAB (input) INTEGER 00066 * The leading dimension of the array AB. LDAB >= KL+KU+1. 00067 * 00068 * WORK (workspace) REAL array, dimension (MAX(1,LWORK)), 00069 * where LWORK >= N when NORM = 'I'; otherwise, WORK is not 00070 * referenced. 00071 * 00072 * ===================================================================== 00073 * 00074 * 00075 * .. Parameters .. 00076 REAL ONE, ZERO 00077 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 00078 * .. 00079 * .. Local Scalars .. 00080 INTEGER I, J, K, L 00081 REAL SCALE, SUM, VALUE 00082 * .. 00083 * .. External Subroutines .. 00084 EXTERNAL SLASSQ 00085 * .. 00086 * .. External Functions .. 00087 LOGICAL LSAME 00088 EXTERNAL LSAME 00089 * .. 00090 * .. Intrinsic Functions .. 00091 INTRINSIC ABS, MAX, MIN, SQRT 00092 * .. 00093 * .. Executable Statements .. 00094 * 00095 IF( N.EQ.0 ) THEN 00096 VALUE = ZERO 00097 ELSE IF( LSAME( NORM, 'M' ) ) THEN 00098 * 00099 * Find max(abs(A(i,j))). 00100 * 00101 VALUE = ZERO 00102 DO 20 J = 1, N 00103 DO 10 I = MAX( KU+2-J, 1 ), MIN( N+KU+1-J, KL+KU+1 ) 00104 VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) 00105 10 CONTINUE 00106 20 CONTINUE 00107 ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN 00108 * 00109 * Find norm1(A). 00110 * 00111 VALUE = ZERO 00112 DO 40 J = 1, N 00113 SUM = ZERO 00114 DO 30 I = MAX( KU+2-J, 1 ), MIN( N+KU+1-J, KL+KU+1 ) 00115 SUM = SUM + ABS( AB( I, J ) ) 00116 30 CONTINUE 00117 VALUE = MAX( VALUE, SUM ) 00118 40 CONTINUE 00119 ELSE IF( LSAME( NORM, 'I' ) ) THEN 00120 * 00121 * Find normI(A). 00122 * 00123 DO 50 I = 1, N 00124 WORK( I ) = ZERO 00125 50 CONTINUE 00126 DO 70 J = 1, N 00127 K = KU + 1 - J 00128 DO 60 I = MAX( 1, J-KU ), MIN( N, J+KL ) 00129 WORK( I ) = WORK( I ) + ABS( AB( K+I, J ) ) 00130 60 CONTINUE 00131 70 CONTINUE 00132 VALUE = ZERO 00133 DO 80 I = 1, N 00134 VALUE = MAX( VALUE, WORK( I ) ) 00135 80 CONTINUE 00136 ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN 00137 * 00138 * Find normF(A). 00139 * 00140 SCALE = ZERO 00141 SUM = ONE 00142 DO 90 J = 1, N 00143 L = MAX( 1, J-KU ) 00144 K = KU + 1 - J + L 00145 CALL SLASSQ( MIN( N, J+KL )-L+1, AB( K, J ), 1, SCALE, SUM ) 00146 90 CONTINUE 00147 VALUE = SCALE*SQRT( SUM ) 00148 END IF 00149 * 00150 SLANGB = VALUE 00151 RETURN 00152 * 00153 * End of SLANGB 00154 * 00155 END