 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 REAL FUNCTION CLANHB( NORM, UPLO, N, K, 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, UPLO 00011 INTEGER K, LDAB, N 00012 * .. 00013 * .. Array Arguments .. 00014 REAL WORK( * ) 00015 COMPLEX AB( LDAB, * ) 00016 * .. 00017 * 00018 * Purpose 00019 * ======= 00020 * 00021 * CLANHB returns the value of the one norm, or the Frobenius norm, or 00022 * the infinity norm, or the element of largest absolute value of an 00023 * n by n hermitian band matrix A, with k super-diagonals. 00024 * 00025 * Description 00026 * =========== 00027 * 00028 * CLANHB returns the value 00029 * 00030 * CLANHB = ( max(abs(A(i,j))), NORM = 'M' or 'm' 00031 * ( 00032 * ( norm1(A), NORM = '1', 'O' or 'o' 00033 * ( 00034 * ( normI(A), NORM = 'I' or 'i' 00035 * ( 00036 * ( normF(A), NORM = 'F', 'f', 'E' or 'e' 00037 * 00038 * where norm1 denotes the one norm of a matrix (maximum column sum), 00039 * normI denotes the infinity norm of a matrix (maximum row sum) and 00040 * normF denotes the Frobenius norm of a matrix (square root of sum of 00041 * squares). Note that max(abs(A(i,j))) is not a consistent matrix norm. 00042 * 00043 * Arguments 00044 * ========= 00045 * 00046 * NORM (input) CHARACTER*1 00047 * Specifies the value to be returned in CLANHB as described 00048 * above. 00049 * 00050 * UPLO (input) CHARACTER*1 00051 * Specifies whether the upper or lower triangular part of the 00052 * band matrix A is supplied. 00053 * = 'U': Upper triangular 00054 * = 'L': Lower triangular 00055 * 00056 * N (input) INTEGER 00057 * The order of the matrix A. N >= 0. When N = 0, CLANHB is 00058 * set to zero. 00059 * 00060 * K (input) INTEGER 00061 * The number of super-diagonals or sub-diagonals of the 00062 * band matrix A. K >= 0. 00063 * 00064 * AB (input) COMPLEX array, dimension (LDAB,N) 00065 * The upper or lower triangle of the hermitian band matrix A, 00066 * stored in the first K+1 rows of AB. The j-th column of A is 00067 * stored in the j-th column of the array AB as follows: 00068 * if UPLO = 'U', AB(k+1+i-j,j) = A(i,j) for max(1,j-k)<=i<=j; 00069 * if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+k). 00070 * Note that the imaginary parts of the diagonal elements need 00071 * not be set and are assumed to be zero. 00072 * 00073 * LDAB (input) INTEGER 00074 * The leading dimension of the array AB. LDAB >= K+1. 00075 * 00076 * WORK (workspace) REAL array, dimension (MAX(1,LWORK)), 00077 * where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise, 00078 * WORK is not referenced. 00079 * 00080 * ===================================================================== 00081 * 00082 * .. Parameters .. 00083 REAL ONE, ZERO 00084 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 00085 * .. 00086 * .. Local Scalars .. 00087 INTEGER I, J, L 00088 REAL ABSA, SCALE, SUM, VALUE 00089 * .. 00090 * .. External Functions .. 00091 LOGICAL LSAME 00092 EXTERNAL LSAME 00093 * .. 00094 * .. External Subroutines .. 00095 EXTERNAL CLASSQ 00096 * .. 00097 * .. Intrinsic Functions .. 00098 INTRINSIC ABS, MAX, MIN, REAL, SQRT 00099 * .. 00100 * .. Executable Statements .. 00101 * 00102 IF( N.EQ.0 ) THEN 00103 VALUE = ZERO 00104 ELSE IF( LSAME( NORM, 'M' ) ) THEN 00105 * 00106 * Find max(abs(A(i,j))). 00107 * 00108 VALUE = ZERO 00109 IF( LSAME( UPLO, 'U' ) ) THEN 00110 DO 20 J = 1, N 00111 DO 10 I = MAX( K+2-J, 1 ), K 00112 VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) 00113 10 CONTINUE 00114 VALUE = MAX( VALUE, ABS( REAL( AB( K+1, J ) ) ) ) 00115 20 CONTINUE 00116 ELSE 00117 DO 40 J = 1, N 00118 VALUE = MAX( VALUE, ABS( REAL( AB( 1, J ) ) ) ) 00119 DO 30 I = 2, MIN( N+1-J, K+1 ) 00120 VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) 00121 30 CONTINUE 00122 40 CONTINUE 00123 END IF 00124 ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR. 00125 $ ( NORM.EQ.'1' ) ) THEN 00126 * 00127 * Find normI(A) ( = norm1(A), since A is hermitian). 00128 * 00129 VALUE = ZERO 00130 IF( LSAME( UPLO, 'U' ) ) THEN 00131 DO 60 J = 1, N 00132 SUM = ZERO 00133 L = K + 1 - J 00134 DO 50 I = MAX( 1, J-K ), J - 1 00135 ABSA = ABS( AB( L+I, J ) ) 00136 SUM = SUM + ABSA 00137 WORK( I ) = WORK( I ) + ABSA 00138 50 CONTINUE 00139 WORK( J ) = SUM + ABS( REAL( AB( K+1, J ) ) ) 00140 60 CONTINUE 00141 DO 70 I = 1, N 00142 VALUE = MAX( VALUE, WORK( I ) ) 00143 70 CONTINUE 00144 ELSE 00145 DO 80 I = 1, N 00146 WORK( I ) = ZERO 00147 80 CONTINUE 00148 DO 100 J = 1, N 00149 SUM = WORK( J ) + ABS( REAL( AB( 1, J ) ) ) 00150 L = 1 - J 00151 DO 90 I = J + 1, MIN( N, J+K ) 00152 ABSA = ABS( AB( L+I, J ) ) 00153 SUM = SUM + ABSA 00154 WORK( I ) = WORK( I ) + ABSA 00155 90 CONTINUE 00156 VALUE = MAX( VALUE, SUM ) 00157 100 CONTINUE 00158 END IF 00159 ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN 00160 * 00161 * Find normF(A). 00162 * 00163 SCALE = ZERO 00164 SUM = ONE 00165 IF( K.GT.0 ) THEN 00166 IF( LSAME( UPLO, 'U' ) ) THEN 00167 DO 110 J = 2, N 00168 CALL CLASSQ( MIN( J-1, K ), AB( MAX( K+2-J, 1 ), J ), 00169 $ 1, SCALE, SUM ) 00170 110 CONTINUE 00171 L = K + 1 00172 ELSE 00173 DO 120 J = 1, N - 1 00174 CALL CLASSQ( MIN( N-J, K ), AB( 2, J ), 1, SCALE, 00175 $ SUM ) 00176 120 CONTINUE 00177 L = 1 00178 END IF 00179 SUM = 2*SUM 00180 ELSE 00181 L = 1 00182 END IF 00183 DO 130 J = 1, N 00184 IF( REAL( AB( L, J ) ).NE.ZERO ) THEN 00185 ABSA = ABS( REAL( AB( L, J ) ) ) 00186 IF( SCALE.LT.ABSA ) THEN 00187 SUM = ONE + SUM*( SCALE / ABSA )**2 00188 SCALE = ABSA 00189 ELSE 00190 SUM = SUM + ( ABSA / SCALE )**2 00191 END IF 00192 END IF 00193 130 CONTINUE 00194 VALUE = SCALE*SQRT( SUM ) 00195 END IF 00196 * 00197 CLANHB = VALUE 00198 RETURN 00199 * 00200 * End of CLANHB 00201 * 00202 END
1.7.3 
