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