![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b CLANHS 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download CLANHS + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clanhs.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clanhs.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clanhs.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * REAL FUNCTION CLANHS( NORM, N, A, LDA, WORK ) 00022 * 00023 * .. Scalar Arguments .. 00024 * CHARACTER NORM 00025 * INTEGER LDA, N 00026 * .. 00027 * .. Array Arguments .. 00028 * REAL WORK( * ) 00029 * COMPLEX A( LDA, * ) 00030 * .. 00031 * 00032 * 00033 *> \par Purpose: 00034 * ============= 00035 *> 00036 *> \verbatim 00037 *> 00038 *> CLANHS returns the value of the one norm, or the Frobenius norm, or 00039 *> the infinity norm, or the element of largest absolute value of a 00040 *> Hessenberg matrix A. 00041 *> \endverbatim 00042 *> 00043 *> \return CLANHS 00044 *> \verbatim 00045 *> 00046 *> CLANHS = ( 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 CLANHS as described 00067 *> above. 00068 *> \endverbatim 00069 *> 00070 *> \param[in] N 00071 *> \verbatim 00072 *> N is INTEGER 00073 *> The order of the matrix A. N >= 0. When N = 0, CLANHS is 00074 *> set to zero. 00075 *> \endverbatim 00076 *> 00077 *> \param[in] A 00078 *> \verbatim 00079 *> A is COMPLEX array, dimension (LDA,N) 00080 *> The n by n upper Hessenberg matrix A; the part of A below the 00081 *> first sub-diagonal is not referenced. 00082 *> \endverbatim 00083 *> 00084 *> \param[in] LDA 00085 *> \verbatim 00086 *> LDA is INTEGER 00087 *> The leading dimension of the array A. LDA >= max(N,1). 00088 *> \endverbatim 00089 *> 00090 *> \param[out] WORK 00091 *> \verbatim 00092 *> WORK is REAL array, dimension (MAX(1,LWORK)), 00093 *> where LWORK >= N when NORM = 'I'; otherwise, WORK is not 00094 *> referenced. 00095 *> \endverbatim 00096 * 00097 * Authors: 00098 * ======== 00099 * 00100 *> \author Univ. of Tennessee 00101 *> \author Univ. of California Berkeley 00102 *> \author Univ. of Colorado Denver 00103 *> \author NAG Ltd. 00104 * 00105 *> \date November 2011 00106 * 00107 *> \ingroup complexOTHERauxiliary 00108 * 00109 * ===================================================================== 00110 REAL FUNCTION CLANHS( NORM, N, A, LDA, WORK ) 00111 * 00112 * -- LAPACK auxiliary routine (version 3.4.0) -- 00113 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00114 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00115 * November 2011 00116 * 00117 * .. Scalar Arguments .. 00118 CHARACTER NORM 00119 INTEGER LDA, N 00120 * .. 00121 * .. Array Arguments .. 00122 REAL WORK( * ) 00123 COMPLEX A( LDA, * ) 00124 * .. 00125 * 00126 * ===================================================================== 00127 * 00128 * .. Parameters .. 00129 REAL ONE, ZERO 00130 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 00131 * .. 00132 * .. Local Scalars .. 00133 INTEGER I, J 00134 REAL SCALE, SUM, VALUE 00135 * .. 00136 * .. External Functions .. 00137 LOGICAL LSAME 00138 EXTERNAL LSAME 00139 * .. 00140 * .. External Subroutines .. 00141 EXTERNAL CLASSQ 00142 * .. 00143 * .. Intrinsic Functions .. 00144 INTRINSIC ABS, MAX, MIN, SQRT 00145 * .. 00146 * .. Executable Statements .. 00147 * 00148 IF( N.EQ.0 ) THEN 00149 VALUE = ZERO 00150 ELSE IF( LSAME( NORM, 'M' ) ) THEN 00151 * 00152 * Find max(abs(A(i,j))). 00153 * 00154 VALUE = ZERO 00155 DO 20 J = 1, N 00156 DO 10 I = 1, MIN( N, J+1 ) 00157 VALUE = MAX( VALUE, ABS( A( I, J ) ) ) 00158 10 CONTINUE 00159 20 CONTINUE 00160 ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN 00161 * 00162 * Find norm1(A). 00163 * 00164 VALUE = ZERO 00165 DO 40 J = 1, N 00166 SUM = ZERO 00167 DO 30 I = 1, MIN( N, J+1 ) 00168 SUM = SUM + ABS( A( I, J ) ) 00169 30 CONTINUE 00170 VALUE = MAX( VALUE, SUM ) 00171 40 CONTINUE 00172 ELSE IF( LSAME( NORM, 'I' ) ) THEN 00173 * 00174 * Find normI(A). 00175 * 00176 DO 50 I = 1, N 00177 WORK( I ) = ZERO 00178 50 CONTINUE 00179 DO 70 J = 1, N 00180 DO 60 I = 1, MIN( N, J+1 ) 00181 WORK( I ) = WORK( I ) + ABS( A( I, J ) ) 00182 60 CONTINUE 00183 70 CONTINUE 00184 VALUE = ZERO 00185 DO 80 I = 1, N 00186 VALUE = MAX( VALUE, WORK( I ) ) 00187 80 CONTINUE 00188 ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN 00189 * 00190 * Find normF(A). 00191 * 00192 SCALE = ZERO 00193 SUM = ONE 00194 DO 90 J = 1, N 00195 CALL CLASSQ( MIN( N, J+1 ), A( 1, J ), 1, SCALE, SUM ) 00196 90 CONTINUE 00197 VALUE = SCALE*SQRT( SUM ) 00198 END IF 00199 * 00200 CLANHS = VALUE 00201 RETURN 00202 * 00203 * End of CLANHS 00204 * 00205 END