![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b DLANSB 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download DLANSB + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlansb.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlansb.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlansb.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * DOUBLE PRECISION FUNCTION DLANSB( NORM, UPLO, N, K, AB, LDAB, 00022 * WORK ) 00023 * 00024 * .. Scalar Arguments .. 00025 * CHARACTER NORM, UPLO 00026 * INTEGER K, LDAB, N 00027 * .. 00028 * .. Array Arguments .. 00029 * DOUBLE PRECISION AB( LDAB, * ), WORK( * ) 00030 * .. 00031 * 00032 * 00033 *> \par Purpose: 00034 * ============= 00035 *> 00036 *> \verbatim 00037 *> 00038 *> DLANSB returns the value of the one norm, or the Frobenius norm, or 00039 *> the infinity norm, or the element of largest absolute value of an 00040 *> n by n symmetric band matrix A, with k super-diagonals. 00041 *> \endverbatim 00042 *> 00043 *> \return DLANSB 00044 *> \verbatim 00045 *> 00046 *> DLANSB = ( max(abs(A(i,j))), NORM = 'M' or 'm' 00047 *> ( 00048 *> ( norm1(A), NORM = '1', 'O' or 'o' 00049 *> ( 00050 *> ( normI(A), NORM = 'I' or 'i' 00051 *> ( 00052 *> ( normF(A), NORM = 'F', 'f', 'E' or 'e' 00053 *> 00054 *> where norm1 denotes the one norm of a matrix (maximum column sum), 00055 *> normI denotes the infinity norm of a matrix (maximum row sum) and 00056 *> normF denotes the Frobenius norm of a matrix (square root of sum of 00057 *> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm. 00058 *> \endverbatim 00059 * 00060 * Arguments: 00061 * ========== 00062 * 00063 *> \param[in] NORM 00064 *> \verbatim 00065 *> NORM is CHARACTER*1 00066 *> Specifies the value to be returned in DLANSB as described 00067 *> above. 00068 *> \endverbatim 00069 *> 00070 *> \param[in] UPLO 00071 *> \verbatim 00072 *> UPLO is CHARACTER*1 00073 *> Specifies whether the upper or lower triangular part of the 00074 *> band matrix A is supplied. 00075 *> = 'U': Upper triangular part is supplied 00076 *> = 'L': Lower triangular part is supplied 00077 *> \endverbatim 00078 *> 00079 *> \param[in] N 00080 *> \verbatim 00081 *> N is INTEGER 00082 *> The order of the matrix A. N >= 0. When N = 0, DLANSB is 00083 *> set to zero. 00084 *> \endverbatim 00085 *> 00086 *> \param[in] K 00087 *> \verbatim 00088 *> K is INTEGER 00089 *> The number of super-diagonals or sub-diagonals of the 00090 *> band matrix A. K >= 0. 00091 *> \endverbatim 00092 *> 00093 *> \param[in] AB 00094 *> \verbatim 00095 *> AB is DOUBLE PRECISION array, dimension (LDAB,N) 00096 *> The upper or lower triangle of the symmetric band matrix A, 00097 *> stored in the first K+1 rows of AB. The j-th column of A is 00098 *> stored in the j-th column of the array AB as follows: 00099 *> if UPLO = 'U', AB(k+1+i-j,j) = A(i,j) for max(1,j-k)<=i<=j; 00100 *> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+k). 00101 *> \endverbatim 00102 *> 00103 *> \param[in] LDAB 00104 *> \verbatim 00105 *> LDAB is INTEGER 00106 *> The leading dimension of the array AB. LDAB >= K+1. 00107 *> \endverbatim 00108 *> 00109 *> \param[out] WORK 00110 *> \verbatim 00111 *> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)), 00112 *> where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise, 00113 *> WORK is not referenced. 00114 *> \endverbatim 00115 * 00116 * Authors: 00117 * ======== 00118 * 00119 *> \author Univ. of Tennessee 00120 *> \author Univ. of California Berkeley 00121 *> \author Univ. of Colorado Denver 00122 *> \author NAG Ltd. 00123 * 00124 *> \date November 2011 00125 * 00126 *> \ingroup doubleOTHERauxiliary 00127 * 00128 * ===================================================================== 00129 DOUBLE PRECISION FUNCTION DLANSB( NORM, UPLO, N, K, AB, LDAB, 00130 $ WORK ) 00131 * 00132 * -- LAPACK auxiliary routine (version 3.4.0) -- 00133 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00134 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00135 * November 2011 00136 * 00137 * .. Scalar Arguments .. 00138 CHARACTER NORM, UPLO 00139 INTEGER K, LDAB, N 00140 * .. 00141 * .. Array Arguments .. 00142 DOUBLE PRECISION AB( LDAB, * ), WORK( * ) 00143 * .. 00144 * 00145 * ===================================================================== 00146 * 00147 * .. Parameters .. 00148 DOUBLE PRECISION ONE, ZERO 00149 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) 00150 * .. 00151 * .. Local Scalars .. 00152 INTEGER I, J, L 00153 DOUBLE PRECISION ABSA, SCALE, SUM, VALUE 00154 * .. 00155 * .. External Subroutines .. 00156 EXTERNAL DLASSQ 00157 * .. 00158 * .. External Functions .. 00159 LOGICAL LSAME 00160 EXTERNAL LSAME 00161 * .. 00162 * .. Intrinsic Functions .. 00163 INTRINSIC ABS, MAX, MIN, SQRT 00164 * .. 00165 * .. Executable Statements .. 00166 * 00167 IF( N.EQ.0 ) THEN 00168 VALUE = ZERO 00169 ELSE IF( LSAME( NORM, 'M' ) ) THEN 00170 * 00171 * Find max(abs(A(i,j))). 00172 * 00173 VALUE = ZERO 00174 IF( LSAME( UPLO, 'U' ) ) THEN 00175 DO 20 J = 1, N 00176 DO 10 I = MAX( K+2-J, 1 ), K + 1 00177 VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) 00178 10 CONTINUE 00179 20 CONTINUE 00180 ELSE 00181 DO 40 J = 1, N 00182 DO 30 I = 1, MIN( N+1-J, K+1 ) 00183 VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) 00184 30 CONTINUE 00185 40 CONTINUE 00186 END IF 00187 ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR. 00188 $ ( NORM.EQ.'1' ) ) THEN 00189 * 00190 * Find normI(A) ( = norm1(A), since A is symmetric). 00191 * 00192 VALUE = ZERO 00193 IF( LSAME( UPLO, 'U' ) ) THEN 00194 DO 60 J = 1, N 00195 SUM = ZERO 00196 L = K + 1 - J 00197 DO 50 I = MAX( 1, J-K ), J - 1 00198 ABSA = ABS( AB( L+I, J ) ) 00199 SUM = SUM + ABSA 00200 WORK( I ) = WORK( I ) + ABSA 00201 50 CONTINUE 00202 WORK( J ) = SUM + ABS( AB( K+1, J ) ) 00203 60 CONTINUE 00204 DO 70 I = 1, N 00205 VALUE = MAX( VALUE, WORK( I ) ) 00206 70 CONTINUE 00207 ELSE 00208 DO 80 I = 1, N 00209 WORK( I ) = ZERO 00210 80 CONTINUE 00211 DO 100 J = 1, N 00212 SUM = WORK( J ) + ABS( AB( 1, J ) ) 00213 L = 1 - J 00214 DO 90 I = J + 1, MIN( N, J+K ) 00215 ABSA = ABS( AB( L+I, J ) ) 00216 SUM = SUM + ABSA 00217 WORK( I ) = WORK( I ) + ABSA 00218 90 CONTINUE 00219 VALUE = MAX( VALUE, SUM ) 00220 100 CONTINUE 00221 END IF 00222 ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN 00223 * 00224 * Find normF(A). 00225 * 00226 SCALE = ZERO 00227 SUM = ONE 00228 IF( K.GT.0 ) THEN 00229 IF( LSAME( UPLO, 'U' ) ) THEN 00230 DO 110 J = 2, N 00231 CALL DLASSQ( MIN( J-1, K ), AB( MAX( K+2-J, 1 ), J ), 00232 $ 1, SCALE, SUM ) 00233 110 CONTINUE 00234 L = K + 1 00235 ELSE 00236 DO 120 J = 1, N - 1 00237 CALL DLASSQ( MIN( N-J, K ), AB( 2, J ), 1, SCALE, 00238 $ SUM ) 00239 120 CONTINUE 00240 L = 1 00241 END IF 00242 SUM = 2*SUM 00243 ELSE 00244 L = 1 00245 END IF 00246 CALL DLASSQ( N, AB( L, 1 ), LDAB, SCALE, SUM ) 00247 VALUE = SCALE*SQRT( SUM ) 00248 END IF 00249 * 00250 DLANSB = VALUE 00251 RETURN 00252 * 00253 * End of DLANSB 00254 * 00255 END