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