 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 REAL FUNCTION SLANHS( NORM, N, A, LDA, WORK ) 00002 * 00003 * -- LAPACK auxiliary routine (version 3.2) -- 00004 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00005 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00006 * November 2006 00007 * 00008 * .. Scalar Arguments .. 00009 CHARACTER NORM 00010 INTEGER LDA, N 00011 * .. 00012 * .. Array Arguments .. 00013 REAL A( LDA, * ), WORK( * ) 00014 * .. 00015 * 00016 * Purpose 00017 * ======= 00018 * 00019 * SLANHS returns the value of the one norm, or the Frobenius norm, or 00020 * the infinity norm, or the element of largest absolute value of a 00021 * Hessenberg matrix A. 00022 * 00023 * Description 00024 * =========== 00025 * 00026 * SLANHS returns the value 00027 * 00028 * SLANHS = ( max(abs(A(i,j))), NORM = 'M' or 'm' 00029 * ( 00030 * ( norm1(A), NORM = '1', 'O' or 'o' 00031 * ( 00032 * ( normI(A), NORM = 'I' or 'i' 00033 * ( 00034 * ( normF(A), NORM = 'F', 'f', 'E' or 'e' 00035 * 00036 * where norm1 denotes the one norm of a matrix (maximum column sum), 00037 * normI denotes the infinity norm of a matrix (maximum row sum) and 00038 * normF denotes the Frobenius norm of a matrix (square root of sum of 00039 * squares). Note that max(abs(A(i,j))) is not a consistent matrix norm. 00040 * 00041 * Arguments 00042 * ========= 00043 * 00044 * NORM (input) CHARACTER*1 00045 * Specifies the value to be returned in SLANHS as described 00046 * above. 00047 * 00048 * N (input) INTEGER 00049 * The order of the matrix A. N >= 0. When N = 0, SLANHS is 00050 * set to zero. 00051 * 00052 * A (input) REAL array, dimension (LDA,N) 00053 * The n by n upper Hessenberg matrix A; the part of A below the 00054 * first sub-diagonal is not referenced. 00055 * 00056 * LDA (input) INTEGER 00057 * The leading dimension of the array A. LDA >= max(N,1). 00058 * 00059 * WORK (workspace) REAL array, dimension (MAX(1,LWORK)), 00060 * where LWORK >= N when NORM = 'I'; otherwise, WORK is not 00061 * referenced. 00062 * 00063 * ===================================================================== 00064 * 00065 * .. Parameters .. 00066 REAL ONE, ZERO 00067 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 00068 * .. 00069 * .. Local Scalars .. 00070 INTEGER I, J 00071 REAL SCALE, SUM, VALUE 00072 * .. 00073 * .. External Subroutines .. 00074 EXTERNAL SLASSQ 00075 * .. 00076 * .. External Functions .. 00077 LOGICAL LSAME 00078 EXTERNAL LSAME 00079 * .. 00080 * .. Intrinsic Functions .. 00081 INTRINSIC ABS, MAX, MIN, SQRT 00082 * .. 00083 * .. Executable Statements .. 00084 * 00085 IF( N.EQ.0 ) THEN 00086 VALUE = ZERO 00087 ELSE IF( LSAME( NORM, 'M' ) ) THEN 00088 * 00089 * Find max(abs(A(i,j))). 00090 * 00091 VALUE = ZERO 00092 DO 20 J = 1, N 00093 DO 10 I = 1, MIN( N, J+1 ) 00094 VALUE = MAX( VALUE, ABS( A( I, J ) ) ) 00095 10 CONTINUE 00096 20 CONTINUE 00097 ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN 00098 * 00099 * Find norm1(A). 00100 * 00101 VALUE = ZERO 00102 DO 40 J = 1, N 00103 SUM = ZERO 00104 DO 30 I = 1, MIN( N, J+1 ) 00105 SUM = SUM + ABS( A( I, J ) ) 00106 30 CONTINUE 00107 VALUE = MAX( VALUE, SUM ) 00108 40 CONTINUE 00109 ELSE IF( LSAME( NORM, 'I' ) ) THEN 00110 * 00111 * Find normI(A). 00112 * 00113 DO 50 I = 1, N 00114 WORK( I ) = ZERO 00115 50 CONTINUE 00116 DO 70 J = 1, N 00117 DO 60 I = 1, MIN( N, J+1 ) 00118 WORK( I ) = WORK( I ) + ABS( A( I, J ) ) 00119 60 CONTINUE 00120 70 CONTINUE 00121 VALUE = ZERO 00122 DO 80 I = 1, N 00123 VALUE = MAX( VALUE, WORK( I ) ) 00124 80 CONTINUE 00125 ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN 00126 * 00127 * Find normF(A). 00128 * 00129 SCALE = ZERO 00130 SUM = ONE 00131 DO 90 J = 1, N 00132 CALL SLASSQ( MIN( N, J+1 ), A( 1, J ), 1, SCALE, SUM ) 00133 90 CONTINUE 00134 VALUE = SCALE*SQRT( SUM ) 00135 END IF 00136 * 00137 SLANHS = VALUE 00138 RETURN 00139 * 00140 * End of SLANHS 00141 * 00142 END
1.7.3 
