00001 /* zlaqgb.f -- translated by f2c (version 20061008). 00002 You must link the resulting object file with libf2c: 00003 on Microsoft Windows system, link with libf2c.lib; 00004 on Linux or Unix systems, link with .../path/to/libf2c.a -lm 00005 or, if you install libf2c.a in a standard place, with -lf2c -lm 00006 -- in that order, at the end of the command line, as in 00007 cc *.o -lf2c -lm 00008 Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., 00009 00010 http://www.netlib.org/f2c/libf2c.zip 00011 */ 00012 00013 #include "f2c.h" 00014 #include "blaswrap.h" 00015 00016 /* Subroutine */ int zlaqgb_(integer *m, integer *n, integer *kl, integer *ku, 00017 doublecomplex *ab, integer *ldab, doublereal *r__, doublereal *c__, 00018 doublereal *rowcnd, doublereal *colcnd, doublereal *amax, char *equed) 00019 { 00020 /* System generated locals */ 00021 integer ab_dim1, ab_offset, i__1, i__2, i__3, i__4, i__5, i__6; 00022 doublereal d__1; 00023 doublecomplex z__1; 00024 00025 /* Local variables */ 00026 integer i__, j; 00027 doublereal cj, large, small; 00028 extern doublereal dlamch_(char *); 00029 00030 00031 /* -- LAPACK auxiliary routine (version 3.2) -- */ 00032 /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ 00033 /* November 2006 */ 00034 00035 /* .. Scalar Arguments .. */ 00036 /* .. */ 00037 /* .. Array Arguments .. */ 00038 /* .. */ 00039 00040 /* Purpose */ 00041 /* ======= */ 00042 00043 /* ZLAQGB equilibrates a general M by N band matrix A with KL */ 00044 /* subdiagonals and KU superdiagonals using the row and scaling factors */ 00045 /* in the vectors R and C. */ 00046 00047 /* Arguments */ 00048 /* ========= */ 00049 00050 /* M (input) INTEGER */ 00051 /* The number of rows of the matrix A. M >= 0. */ 00052 00053 /* N (input) INTEGER */ 00054 /* The number of columns of the matrix A. N >= 0. */ 00055 00056 /* KL (input) INTEGER */ 00057 /* The number of subdiagonals within the band of A. KL >= 0. */ 00058 00059 /* KU (input) INTEGER */ 00060 /* The number of superdiagonals within the band of A. KU >= 0. */ 00061 00062 /* AB (input/output) COMPLEX*16 array, dimension (LDAB,N) */ 00063 /* On entry, the matrix A in band storage, in rows 1 to KL+KU+1. */ 00064 /* The j-th column of A is stored in the j-th column of the */ 00065 /* array AB as follows: */ 00066 /* AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl) */ 00067 00068 /* On exit, the equilibrated matrix, in the same storage format */ 00069 /* as A. See EQUED for the form of the equilibrated matrix. */ 00070 00071 /* LDAB (input) INTEGER */ 00072 /* The leading dimension of the array AB. LDA >= KL+KU+1. */ 00073 00074 /* R (input) DOUBLE PRECISION array, dimension (M) */ 00075 /* The row scale factors for A. */ 00076 00077 /* C (input) DOUBLE PRECISION array, dimension (N) */ 00078 /* The column scale factors for A. */ 00079 00080 /* ROWCND (input) DOUBLE PRECISION */ 00081 /* Ratio of the smallest R(i) to the largest R(i). */ 00082 00083 /* COLCND (input) DOUBLE PRECISION */ 00084 /* Ratio of the smallest C(i) to the largest C(i). */ 00085 00086 /* AMAX (input) DOUBLE PRECISION */ 00087 /* Absolute value of largest matrix entry. */ 00088 00089 /* EQUED (output) CHARACTER*1 */ 00090 /* Specifies the form of equilibration that was done. */ 00091 /* = 'N': No equilibration */ 00092 /* = 'R': Row equilibration, i.e., A has been premultiplied by */ 00093 /* diag(R). */ 00094 /* = 'C': Column equilibration, i.e., A has been postmultiplied */ 00095 /* by diag(C). */ 00096 /* = 'B': Both row and column equilibration, i.e., A has been */ 00097 /* replaced by diag(R) * A * diag(C). */ 00098 00099 /* Internal Parameters */ 00100 /* =================== */ 00101 00102 /* THRESH is a threshold value used to decide if row or column scaling */ 00103 /* should be done based on the ratio of the row or column scaling */ 00104 /* factors. If ROWCND < THRESH, row scaling is done, and if */ 00105 /* COLCND < THRESH, column scaling is done. */ 00106 00107 /* LARGE and SMALL are threshold values used to decide if row scaling */ 00108 /* should be done based on the absolute size of the largest matrix */ 00109 /* element. If AMAX > LARGE or AMAX < SMALL, row scaling is done. */ 00110 00111 /* ===================================================================== */ 00112 00113 /* .. Parameters .. */ 00114 /* .. */ 00115 /* .. Local Scalars .. */ 00116 /* .. */ 00117 /* .. External Functions .. */ 00118 /* .. */ 00119 /* .. Intrinsic Functions .. */ 00120 /* .. */ 00121 /* .. Executable Statements .. */ 00122 00123 /* Quick return if possible */ 00124 00125 /* Parameter adjustments */ 00126 ab_dim1 = *ldab; 00127 ab_offset = 1 + ab_dim1; 00128 ab -= ab_offset; 00129 --r__; 00130 --c__; 00131 00132 /* Function Body */ 00133 if (*m <= 0 || *n <= 0) { 00134 *(unsigned char *)equed = 'N'; 00135 return 0; 00136 } 00137 00138 /* Initialize LARGE and SMALL. */ 00139 00140 small = dlamch_("Safe minimum") / dlamch_("Precision"); 00141 large = 1. / small; 00142 00143 if (*rowcnd >= .1 && *amax >= small && *amax <= large) { 00144 00145 /* No row scaling */ 00146 00147 if (*colcnd >= .1) { 00148 00149 /* No column scaling */ 00150 00151 *(unsigned char *)equed = 'N'; 00152 } else { 00153 00154 /* Column scaling */ 00155 00156 i__1 = *n; 00157 for (j = 1; j <= i__1; ++j) { 00158 cj = c__[j]; 00159 /* Computing MAX */ 00160 i__2 = 1, i__3 = j - *ku; 00161 /* Computing MIN */ 00162 i__5 = *m, i__6 = j + *kl; 00163 i__4 = min(i__5,i__6); 00164 for (i__ = max(i__2,i__3); i__ <= i__4; ++i__) { 00165 i__2 = *ku + 1 + i__ - j + j * ab_dim1; 00166 i__3 = *ku + 1 + i__ - j + j * ab_dim1; 00167 z__1.r = cj * ab[i__3].r, z__1.i = cj * ab[i__3].i; 00168 ab[i__2].r = z__1.r, ab[i__2].i = z__1.i; 00169 /* L10: */ 00170 } 00171 /* L20: */ 00172 } 00173 *(unsigned char *)equed = 'C'; 00174 } 00175 } else if (*colcnd >= .1) { 00176 00177 /* Row scaling, no column scaling */ 00178 00179 i__1 = *n; 00180 for (j = 1; j <= i__1; ++j) { 00181 /* Computing MAX */ 00182 i__4 = 1, i__2 = j - *ku; 00183 /* Computing MIN */ 00184 i__5 = *m, i__6 = j + *kl; 00185 i__3 = min(i__5,i__6); 00186 for (i__ = max(i__4,i__2); i__ <= i__3; ++i__) { 00187 i__4 = *ku + 1 + i__ - j + j * ab_dim1; 00188 i__2 = i__; 00189 i__5 = *ku + 1 + i__ - j + j * ab_dim1; 00190 z__1.r = r__[i__2] * ab[i__5].r, z__1.i = r__[i__2] * ab[i__5] 00191 .i; 00192 ab[i__4].r = z__1.r, ab[i__4].i = z__1.i; 00193 /* L30: */ 00194 } 00195 /* L40: */ 00196 } 00197 *(unsigned char *)equed = 'R'; 00198 } else { 00199 00200 /* Row and column scaling */ 00201 00202 i__1 = *n; 00203 for (j = 1; j <= i__1; ++j) { 00204 cj = c__[j]; 00205 /* Computing MAX */ 00206 i__3 = 1, i__4 = j - *ku; 00207 /* Computing MIN */ 00208 i__5 = *m, i__6 = j + *kl; 00209 i__2 = min(i__5,i__6); 00210 for (i__ = max(i__3,i__4); i__ <= i__2; ++i__) { 00211 i__3 = *ku + 1 + i__ - j + j * ab_dim1; 00212 d__1 = cj * r__[i__]; 00213 i__4 = *ku + 1 + i__ - j + j * ab_dim1; 00214 z__1.r = d__1 * ab[i__4].r, z__1.i = d__1 * ab[i__4].i; 00215 ab[i__3].r = z__1.r, ab[i__3].i = z__1.i; 00216 /* L50: */ 00217 } 00218 /* L60: */ 00219 } 00220 *(unsigned char *)equed = 'B'; 00221 } 00222 00223 return 0; 00224 00225 /* End of ZLAQGB */ 00226 00227 } /* zlaqgb_ */