00001 SUBROUTINE CLAQGE( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, 00002 $ EQUED ) 00003 * 00004 * -- LAPACK auxiliary routine (version 3.2) -- 00005 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00006 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00007 * November 2006 00008 * 00009 * .. Scalar Arguments .. 00010 CHARACTER EQUED 00011 INTEGER LDA, M, N 00012 REAL AMAX, COLCND, ROWCND 00013 * .. 00014 * .. Array Arguments .. 00015 REAL C( * ), R( * ) 00016 COMPLEX A( LDA, * ) 00017 * .. 00018 * 00019 * Purpose 00020 * ======= 00021 * 00022 * CLAQGE equilibrates a general M by N matrix A using the row and 00023 * column scaling factors in the vectors R and C. 00024 * 00025 * Arguments 00026 * ========= 00027 * 00028 * M (input) INTEGER 00029 * The number of rows of the matrix A. M >= 0. 00030 * 00031 * N (input) INTEGER 00032 * The number of columns of the matrix A. N >= 0. 00033 * 00034 * A (input/output) COMPLEX array, dimension (LDA,N) 00035 * On entry, the M by N matrix A. 00036 * On exit, the equilibrated matrix. See EQUED for the form of 00037 * the equilibrated matrix. 00038 * 00039 * LDA (input) INTEGER 00040 * The leading dimension of the array A. LDA >= max(M,1). 00041 * 00042 * R (input) REAL array, dimension (M) 00043 * The row scale factors for A. 00044 * 00045 * C (input) REAL array, dimension (N) 00046 * The column scale factors for A. 00047 * 00048 * ROWCND (input) REAL 00049 * Ratio of the smallest R(i) to the largest R(i). 00050 * 00051 * COLCND (input) REAL 00052 * Ratio of the smallest C(i) to the largest C(i). 00053 * 00054 * AMAX (input) REAL 00055 * Absolute value of largest matrix entry. 00056 * 00057 * EQUED (output) CHARACTER*1 00058 * Specifies the form of equilibration that was done. 00059 * = 'N': No equilibration 00060 * = 'R': Row equilibration, i.e., A has been premultiplied by 00061 * diag(R). 00062 * = 'C': Column equilibration, i.e., A has been postmultiplied 00063 * by diag(C). 00064 * = 'B': Both row and column equilibration, i.e., A has been 00065 * replaced by diag(R) * A * diag(C). 00066 * 00067 * Internal Parameters 00068 * =================== 00069 * 00070 * THRESH is a threshold value used to decide if row or column scaling 00071 * should be done based on the ratio of the row or column scaling 00072 * factors. If ROWCND < THRESH, row scaling is done, and if 00073 * COLCND < THRESH, column scaling is done. 00074 * 00075 * LARGE and SMALL are threshold values used to decide if row scaling 00076 * should be done based on the absolute size of the largest matrix 00077 * element. If AMAX > LARGE or AMAX < SMALL, row scaling is done. 00078 * 00079 * ===================================================================== 00080 * 00081 * .. Parameters .. 00082 REAL ONE, THRESH 00083 PARAMETER ( ONE = 1.0E+0, THRESH = 0.1E+0 ) 00084 * .. 00085 * .. Local Scalars .. 00086 INTEGER I, J 00087 REAL CJ, LARGE, SMALL 00088 * .. 00089 * .. External Functions .. 00090 REAL SLAMCH 00091 EXTERNAL SLAMCH 00092 * .. 00093 * .. Executable Statements .. 00094 * 00095 * Quick return if possible 00096 * 00097 IF( M.LE.0 .OR. N.LE.0 ) THEN 00098 EQUED = 'N' 00099 RETURN 00100 END IF 00101 * 00102 * Initialize LARGE and SMALL. 00103 * 00104 SMALL = SLAMCH( 'Safe minimum' ) / SLAMCH( 'Precision' ) 00105 LARGE = ONE / SMALL 00106 * 00107 IF( ROWCND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE ) 00108 $ THEN 00109 * 00110 * No row scaling 00111 * 00112 IF( COLCND.GE.THRESH ) THEN 00113 * 00114 * No column scaling 00115 * 00116 EQUED = 'N' 00117 ELSE 00118 * 00119 * Column scaling 00120 * 00121 DO 20 J = 1, N 00122 CJ = C( J ) 00123 DO 10 I = 1, M 00124 A( I, J ) = CJ*A( I, J ) 00125 10 CONTINUE 00126 20 CONTINUE 00127 EQUED = 'C' 00128 END IF 00129 ELSE IF( COLCND.GE.THRESH ) THEN 00130 * 00131 * Row scaling, no column scaling 00132 * 00133 DO 40 J = 1, N 00134 DO 30 I = 1, M 00135 A( I, J ) = R( I )*A( I, J ) 00136 30 CONTINUE 00137 40 CONTINUE 00138 EQUED = 'R' 00139 ELSE 00140 * 00141 * Row and column scaling 00142 * 00143 DO 60 J = 1, N 00144 CJ = C( J ) 00145 DO 50 I = 1, M 00146 A( I, J ) = CJ*R( I )*A( I, J ) 00147 50 CONTINUE 00148 60 CONTINUE 00149 EQUED = 'B' 00150 END IF 00151 * 00152 RETURN 00153 * 00154 * End of CLAQGE 00155 * 00156 END
1.7.2