00001 *** This subroutine includes all of the CLANGE function instead of 00002 *** simply wrapping it in a subroutine to avoid possible differences in 00003 *** the way complex values are returned by various Fortran compilers. 00004 *** For example, if we simply wrap the function and compile this file 00005 *** with gfortran and the library that provides CLANGE is compiled with 00006 *** a compiler that uses the g77 (f2c-compatible) calling convention for 00007 *** complex-valued functions, all hell will break loose. 00008 00009 SUBROUTINE XCLANGE ( NORM, M, N, A, LDA, WORK, VALUE ) 00010 00011 *** DOUBLE PRECISION FUNCTION CLANGE( NORM, M, N, A, LDA, WORK ) 00012 * 00013 * -- LAPACK auxiliary routine (version 3.1) -- 00014 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00015 * November 2006 00016 * 00017 * .. Scalar Arguments .. 00018 CHARACTER NORM 00019 INTEGER LDA, M, N 00020 * .. 00021 * .. Array Arguments .. 00022 DOUBLE PRECISION WORK( * ) 00023 COMPLEX*16 A( LDA, * ) 00024 * .. 00025 * 00026 * Purpose 00027 * ======= 00028 * 00029 * CLANGE returns the value of the one norm, or the Frobenius norm, or 00030 * the infinity norm, or the element of largest absolute value of a 00031 * complex matrix A. 00032 * 00033 * Description 00034 * =========== 00035 * 00036 * CLANGE returns the value 00037 * 00038 * CLANGE = ( max(abs(A(i,j))), NORM = 'M' or 'm' 00039 * ( 00040 * ( norm1(A), NORM = '1', 'O' or 'o' 00041 * ( 00042 * ( normI(A), NORM = 'I' or 'i' 00043 * ( 00044 * ( normF(A), NORM = 'F', 'f', 'E' or 'e' 00045 * 00046 * where norm1 denotes the one norm of a matrix (maximum column sum), 00047 * normI denotes the infinity norm of a matrix (maximum row sum) and 00048 * normF denotes the Frobenius norm of a matrix (square root of sum of 00049 * squares). Note that max(abs(A(i,j))) is not a consistent matrix norm. 00050 * 00051 * Arguments 00052 * ========= 00053 * 00054 * NORM (input) CHARACTER*1 00055 * Specifies the value to be returned in CLANGE as described 00056 * above. 00057 * 00058 * M (input) INTEGER 00059 * The number of rows of the matrix A. M >= 0. When M = 0, 00060 * CLANGE is set to zero. 00061 * 00062 * N (input) INTEGER 00063 * The number of columns of the matrix A. N >= 0. When N = 0, 00064 * CLANGE is set to zero. 00065 * 00066 * A (input) COMPLEX*16 array, dimension (LDA,N) 00067 * The m by n matrix A. 00068 * 00069 * LDA (input) INTEGER 00070 * The leading dimension of the array A. LDA >= max(M,1). 00071 * 00072 * WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)), 00073 * where LWORK >= M when NORM = 'I'; otherwise, WORK is not 00074 * referenced. 00075 * 00076 * ===================================================================== 00077 * 00078 * .. Parameters .. 00079 DOUBLE PRECISION ONE, ZERO 00080 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) 00081 * .. 00082 * .. Local Scalars .. 00083 INTEGER I, J 00084 DOUBLE PRECISION SCALE, SUM, VALUE 00085 * .. 00086 * .. External Functions .. 00087 LOGICAL LSAME 00088 EXTERNAL LSAME 00089 * .. 00090 * .. External Subroutines .. 00091 EXTERNAL CLASSQ 00092 * .. 00093 * .. Intrinsic Functions .. 00094 INTRINSIC ABS, MAX, MIN, SQRT 00095 * .. 00096 * .. Executable Statements .. 00097 * 00098 IF( MIN( M, N ).EQ.0 ) THEN 00099 VALUE = ZERO 00100 ELSE IF( LSAME( NORM, 'M' ) ) THEN 00101 * 00102 * Find max(abs(A(i,j))). 00103 * 00104 VALUE = ZERO 00105 DO 20 J = 1, N 00106 DO 10 I = 1, M 00107 VALUE = MAX( VALUE, ABS( A( I, J ) ) ) 00108 10 CONTINUE 00109 20 CONTINUE 00110 ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN 00111 * 00112 * Find norm1(A). 00113 * 00114 VALUE = ZERO 00115 DO 40 J = 1, N 00116 SUM = ZERO 00117 DO 30 I = 1, M 00118 SUM = SUM + ABS( A( I, J ) ) 00119 30 CONTINUE 00120 VALUE = MAX( VALUE, SUM ) 00121 40 CONTINUE 00122 ELSE IF( LSAME( NORM, 'I' ) ) THEN 00123 * 00124 * Find normI(A). 00125 * 00126 DO 50 I = 1, M 00127 WORK( I ) = ZERO 00128 50 CONTINUE 00129 DO 70 J = 1, N 00130 DO 60 I = 1, M 00131 WORK( I ) = WORK( I ) + ABS( A( I, J ) ) 00132 60 CONTINUE 00133 70 CONTINUE 00134 VALUE = ZERO 00135 DO 80 I = 1, M 00136 VALUE = MAX( VALUE, WORK( I ) ) 00137 80 CONTINUE 00138 ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN 00139 * 00140 * Find normF(A). 00141 * 00142 SCALE = ZERO 00143 SUM = ONE 00144 DO 90 J = 1, N 00145 CALL CLASSQ( M, A( 1, J ), 1, SCALE, SUM ) 00146 90 CONTINUE 00147 VALUE = SCALE*SQRT( SUM ) 00148 END IF 00149 * 00150 *** CLANGE = VALUE 00151 RETURN 00152 * 00153 * End of CLANGE 00154 * 00155 END
1.7.1
