1*> \brief \b CLANHB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a Hermitian band matrix. 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8*> \htmlonly 9*> Download CLANHB + dependencies 10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clanhb.f"> 11*> [TGZ]</a> 12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clanhb.f"> 13*> [ZIP]</a> 14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clanhb.f"> 15*> [TXT]</a> 16*> \endhtmlonly 17* 18* Definition: 19* =========== 20* 21* REAL FUNCTION CLANHB( NORM, UPLO, N, K, AB, LDAB, 22* WORK ) 23* 24* .. Scalar Arguments .. 25* CHARACTER NORM, UPLO 26* INTEGER K, LDAB, N 27* .. 28* .. Array Arguments .. 29* REAL WORK( * ) 30* COMPLEX AB( LDAB, * ) 31* .. 32* 33* 34*> \par Purpose: 35* ============= 36*> 37*> \verbatim 38*> 39*> CLANHB returns the value of the one norm, or the Frobenius norm, or 40*> the infinity norm, or the element of largest absolute value of an 41*> n by n hermitian band matrix A, with k super-diagonals. 42*> \endverbatim 43*> 44*> \return CLANHB 45*> \verbatim 46*> 47*> CLANHB = ( max(abs(A(i,j))), NORM = 'M' or 'm' 48*> ( 49*> ( norm1(A), NORM = '1', 'O' or 'o' 50*> ( 51*> ( normI(A), NORM = 'I' or 'i' 52*> ( 53*> ( normF(A), NORM = 'F', 'f', 'E' or 'e' 54*> 55*> where norm1 denotes the one norm of a matrix (maximum column sum), 56*> normI denotes the infinity norm of a matrix (maximum row sum) and 57*> normF denotes the Frobenius norm of a matrix (square root of sum of 58*> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm. 59*> \endverbatim 60* 61* Arguments: 62* ========== 63* 64*> \param[in] NORM 65*> \verbatim 66*> NORM is CHARACTER*1 67*> Specifies the value to be returned in CLANHB as described 68*> above. 69*> \endverbatim 70*> 71*> \param[in] UPLO 72*> \verbatim 73*> UPLO is CHARACTER*1 74*> Specifies whether the upper or lower triangular part of the 75*> band matrix A is supplied. 76*> = 'U': Upper triangular 77*> = 'L': Lower triangular 78*> \endverbatim 79*> 80*> \param[in] N 81*> \verbatim 82*> N is INTEGER 83*> The order of the matrix A. N >= 0. When N = 0, CLANHB is 84*> set to zero. 85*> \endverbatim 86*> 87*> \param[in] K 88*> \verbatim 89*> K is INTEGER 90*> The number of super-diagonals or sub-diagonals of the 91*> band matrix A. K >= 0. 92*> \endverbatim 93*> 94*> \param[in] AB 95*> \verbatim 96*> AB is COMPLEX array, dimension (LDAB,N) 97*> The upper or lower triangle of the hermitian band matrix A, 98*> stored in the first K+1 rows of AB. The j-th column of A is 99*> stored in the j-th column of the array AB as follows: 100*> if UPLO = 'U', AB(k+1+i-j,j) = A(i,j) for max(1,j-k)<=i<=j; 101*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+k). 102*> Note that the imaginary parts of the diagonal elements need 103*> not be set and are assumed to be zero. 104*> \endverbatim 105*> 106*> \param[in] LDAB 107*> \verbatim 108*> LDAB is INTEGER 109*> The leading dimension of the array AB. LDAB >= K+1. 110*> \endverbatim 111*> 112*> \param[out] WORK 113*> \verbatim 114*> WORK is REAL array, dimension (MAX(1,LWORK)), 115*> where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise, 116*> WORK is not referenced. 117*> \endverbatim 118* 119* Authors: 120* ======== 121* 122*> \author Univ. of Tennessee 123*> \author Univ. of California Berkeley 124*> \author Univ. of Colorado Denver 125*> \author NAG Ltd. 126* 127*> \ingroup complexOTHERauxiliary 128* 129* ===================================================================== 130 REAL FUNCTION CLANHB( NORM, UPLO, N, K, AB, LDAB, 131 $ WORK ) 132* 133* -- LAPACK auxiliary routine -- 134* -- LAPACK is a software package provided by Univ. of Tennessee, -- 135* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 136* 137 IMPLICIT NONE 138* .. Scalar Arguments .. 139 CHARACTER NORM, UPLO 140 INTEGER K, LDAB, N 141* .. 142* .. Array Arguments .. 143 REAL WORK( * ) 144 COMPLEX AB( LDAB, * ) 145* .. 146* 147* ===================================================================== 148* 149* .. Parameters .. 150 REAL ONE, ZERO 151 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 152* .. 153* .. Local Scalars .. 154 INTEGER I, J, L 155 REAL ABSA, SUM, VALUE 156* .. 157* .. Local Arrays .. 158 REAL SSQ( 2 ), COLSSQ( 2 ) 159* .. 160* .. External Functions .. 161 LOGICAL LSAME, SISNAN 162 EXTERNAL LSAME, SISNAN 163* .. 164* .. External Subroutines .. 165 EXTERNAL CLASSQ, SCOMBSSQ 166* .. 167* .. Intrinsic Functions .. 168 INTRINSIC ABS, MAX, MIN, REAL, SQRT 169* .. 170* .. Executable Statements .. 171* 172 IF( N.EQ.0 ) THEN 173 VALUE = ZERO 174 ELSE IF( LSAME( NORM, 'M' ) ) THEN 175* 176* Find max(abs(A(i,j))). 177* 178 VALUE = ZERO 179 IF( LSAME( UPLO, 'U' ) ) THEN 180 DO 20 J = 1, N 181 DO 10 I = MAX( K+2-J, 1 ), K 182 SUM = ABS( AB( I, J ) ) 183 IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 184 10 CONTINUE 185 SUM = ABS( REAL( AB( K+1, J ) ) ) 186 IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 187 20 CONTINUE 188 ELSE 189 DO 40 J = 1, N 190 SUM = ABS( REAL( AB( 1, J ) ) ) 191 IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 192 DO 30 I = 2, MIN( N+1-J, K+1 ) 193 SUM = ABS( AB( I, J ) ) 194 IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 195 30 CONTINUE 196 40 CONTINUE 197 END IF 198 ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR. 199 $ ( NORM.EQ.'1' ) ) THEN 200* 201* Find normI(A) ( = norm1(A), since A is hermitian). 202* 203 VALUE = ZERO 204 IF( LSAME( UPLO, 'U' ) ) THEN 205 DO 60 J = 1, N 206 SUM = ZERO 207 L = K + 1 - J 208 DO 50 I = MAX( 1, J-K ), J - 1 209 ABSA = ABS( AB( L+I, J ) ) 210 SUM = SUM + ABSA 211 WORK( I ) = WORK( I ) + ABSA 212 50 CONTINUE 213 WORK( J ) = SUM + ABS( REAL( AB( K+1, J ) ) ) 214 60 CONTINUE 215 DO 70 I = 1, N 216 SUM = WORK( I ) 217 IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 218 70 CONTINUE 219 ELSE 220 DO 80 I = 1, N 221 WORK( I ) = ZERO 222 80 CONTINUE 223 DO 100 J = 1, N 224 SUM = WORK( J ) + ABS( REAL( AB( 1, J ) ) ) 225 L = 1 - J 226 DO 90 I = J + 1, MIN( N, J+K ) 227 ABSA = ABS( AB( L+I, J ) ) 228 SUM = SUM + ABSA 229 WORK( I ) = WORK( I ) + ABSA 230 90 CONTINUE 231 IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 232 100 CONTINUE 233 END IF 234 ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN 235* 236* Find normF(A). 237* SSQ(1) is scale 238* SSQ(2) is sum-of-squares 239* For better accuracy, sum each column separately. 240* 241 SSQ( 1 ) = ZERO 242 SSQ( 2 ) = ONE 243* 244* Sum off-diagonals 245* 246 IF( K.GT.0 ) THEN 247 IF( LSAME( UPLO, 'U' ) ) THEN 248 DO 110 J = 2, N 249 COLSSQ( 1 ) = ZERO 250 COLSSQ( 2 ) = ONE 251 CALL CLASSQ( MIN( J-1, K ), AB( MAX( K+2-J, 1 ), J ), 252 $ 1, COLSSQ( 1 ), COLSSQ( 2 ) ) 253 CALL SCOMBSSQ( SSQ, COLSSQ ) 254 110 CONTINUE 255 L = K + 1 256 ELSE 257 DO 120 J = 1, N - 1 258 COLSSQ( 1 ) = ZERO 259 COLSSQ( 2 ) = ONE 260 CALL CLASSQ( MIN( N-J, K ), AB( 2, J ), 1, 261 $ COLSSQ( 1 ), COLSSQ( 2 ) ) 262 CALL SCOMBSSQ( SSQ, COLSSQ ) 263 120 CONTINUE 264 L = 1 265 END IF 266 SSQ( 2 ) = 2*SSQ( 2 ) 267 ELSE 268 L = 1 269 END IF 270* 271* Sum diagonal 272* 273 COLSSQ( 1 ) = ZERO 274 COLSSQ( 2 ) = ONE 275 DO 130 J = 1, N 276 IF( REAL( AB( L, J ) ).NE.ZERO ) THEN 277 ABSA = ABS( REAL( AB( L, J ) ) ) 278 IF( COLSSQ( 1 ).LT.ABSA ) THEN 279 COLSSQ( 2 ) = ONE + COLSSQ(2)*( COLSSQ(1) / ABSA )**2 280 COLSSQ( 1 ) = ABSA 281 ELSE 282 COLSSQ( 2 ) = COLSSQ( 2 ) + ( ABSA / COLSSQ( 1 ) )**2 283 END IF 284 END IF 285 130 CONTINUE 286 CALL SCOMBSSQ( SSQ, COLSSQ ) 287 VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) 288 END IF 289* 290 CLANHB = VALUE 291 RETURN 292* 293* End of CLANHB 294* 295 END 296