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