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