|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 REAL FUNCTION SLANGE( NORM, M, 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, M, N 00011 * .. 00012 * .. Array Arguments .. 00013 REAL A( LDA, * ), WORK( * ) 00014 * .. 00015 * 00016 * Purpose 00017 * ======= 00018 * 00019 * SLANGE 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 * real matrix A. 00022 * 00023 * Description 00024 * =========== 00025 * 00026 * SLANGE returns the value 00027 * 00028 * SLANGE = ( 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 SLANGE as described 00046 * above. 00047 * 00048 * M (input) INTEGER 00049 * The number of rows of the matrix A. M >= 0. When M = 0, 00050 * SLANGE is set to zero. 00051 * 00052 * N (input) INTEGER 00053 * The number of columns of the matrix A. N >= 0. When N = 0, 00054 * SLANGE is set to zero. 00055 * 00056 * A (input) REAL array, dimension (LDA,N) 00057 * The m by n matrix A. 00058 * 00059 * LDA (input) INTEGER 00060 * The leading dimension of the array A. LDA >= max(M,1). 00061 * 00062 * WORK (workspace) REAL array, dimension (MAX(1,LWORK)), 00063 * where LWORK >= M when NORM = 'I'; otherwise, WORK is not 00064 * referenced. 00065 * 00066 * ===================================================================== 00067 * 00068 * .. Parameters .. 00069 REAL ONE, ZERO 00070 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 00071 * .. 00072 * .. Local Scalars .. 00073 INTEGER I, J 00074 REAL SCALE, SUM, VALUE 00075 * .. 00076 * .. External Subroutines .. 00077 EXTERNAL SLASSQ 00078 * .. 00079 * .. External Functions .. 00080 LOGICAL LSAME 00081 EXTERNAL LSAME 00082 * .. 00083 * .. Intrinsic Functions .. 00084 INTRINSIC ABS, MAX, MIN, SQRT 00085 * .. 00086 * .. Executable Statements .. 00087 * 00088 IF( MIN( M, N ).EQ.0 ) THEN 00089 VALUE = ZERO 00090 ELSE IF( LSAME( NORM, 'M' ) ) THEN 00091 * 00092 * Find max(abs(A(i,j))). 00093 * 00094 VALUE = ZERO 00095 DO 20 J = 1, N 00096 DO 10 I = 1, M 00097 VALUE = MAX( VALUE, ABS( A( I, J ) ) ) 00098 10 CONTINUE 00099 20 CONTINUE 00100 ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN 00101 * 00102 * Find norm1(A). 00103 * 00104 VALUE = ZERO 00105 DO 40 J = 1, N 00106 SUM = ZERO 00107 DO 30 I = 1, M 00108 SUM = SUM + ABS( A( I, J ) ) 00109 30 CONTINUE 00110 VALUE = MAX( VALUE, SUM ) 00111 40 CONTINUE 00112 ELSE IF( LSAME( NORM, 'I' ) ) THEN 00113 * 00114 * Find normI(A). 00115 * 00116 DO 50 I = 1, M 00117 WORK( I ) = ZERO 00118 50 CONTINUE 00119 DO 70 J = 1, N 00120 DO 60 I = 1, M 00121 WORK( I ) = WORK( I ) + ABS( A( I, J ) ) 00122 60 CONTINUE 00123 70 CONTINUE 00124 VALUE = ZERO 00125 DO 80 I = 1, M 00126 VALUE = MAX( VALUE, WORK( I ) ) 00127 80 CONTINUE 00128 ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN 00129 * 00130 * Find normF(A). 00131 * 00132 SCALE = ZERO 00133 SUM = ONE 00134 DO 90 J = 1, N 00135 CALL SLASSQ( M, A( 1, J ), 1, SCALE, SUM ) 00136 90 CONTINUE 00137 VALUE = SCALE*SQRT( SUM ) 00138 END IF 00139 * 00140 SLANGE = VALUE 00141 RETURN 00142 * 00143 * End of SLANGE 00144 * 00145 END
1.7.3 
