00001 /* DLAQGE.F -- translated by f2c (version 19941215). 00002 You must link the resulting object file with the libraries: 00003 -lf2c -lm (in that order) 00004 */ 00005 00006 #include "f2c.h" 00007 00008 /* Subroutine */ int dlaqge_(m, n, a, lda, r, c, rowcnd, colcnd, amax, equed, 00009 equed_len) 00010 integer *m, *n; 00011 doublereal *a; 00012 integer *lda; 00013 doublereal *r, *c, *rowcnd, *colcnd, *amax; 00014 char *equed; 00015 ftnlen equed_len; 00016 { 00017 /* System generated locals */ 00018 integer a_dim1, a_offset, i__1, i__2; 00019 00020 /* Local variables */ 00021 static integer i, j; 00022 static doublereal large, small, cj; 00023 extern doublereal dlamch_(); 00024 00025 00026 /* -- LAPACK auxiliary routine (version 1.1) -- */ 00027 /* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */ 00028 /* Courant Institute, Argonne National Lab, and Rice University */ 00029 /* February 29, 1992 */ 00030 00031 /* .. Scalar Arguments .. */ 00032 /* .. */ 00033 /* .. Array Arguments .. */ 00034 /* .. */ 00035 00036 /* Purpose */ 00037 /* ======= */ 00038 00039 /* DLAQGE equilibrates a general M by N matrix A using the row and */ 00040 /* scaling factors in the vectors R and C. */ 00041 00042 /* Arguments */ 00043 /* ========= */ 00044 00045 /* M (input) INTEGER */ 00046 /* The number of rows of the matrix A. M >= 0. */ 00047 00048 /* N (input) INTEGER */ 00049 /* The number of columns of the matrix A. N >= 0. */ 00050 00051 /* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */ 00052 /* On entry, the M by N matrix A. */ 00053 /* On exit, the equilibrated matrix. See EQUED for the form of 00054 */ 00055 /* the equilibrated matrix. */ 00056 00057 /* LDA (input) INTEGER */ 00058 /* The leading dimension of the array A. LDA >= max(M,1). */ 00059 00060 /* R (input) DOUBLE PRECISION array, dimension (M) */ 00061 /* The row scale factors for A. */ 00062 00063 /* C (input) DOUBLE PRECISION array, dimension (N) */ 00064 /* The column scale factors for A. */ 00065 00066 /* ROWCND (input) DOUBLE PRECISION */ 00067 /* Ratio of the smallest R(i) to the largest R(i). */ 00068 00069 /* COLCND (input) DOUBLE PRECISION */ 00070 /* Ratio of the smallest C(i) to the largest C(i). */ 00071 00072 /* AMAX (input) DOUBLE PRECISION */ 00073 /* Absolute value of largest matrix entry. */ 00074 00075 /* EQUED (output) CHARACTER*1 */ 00076 /* Specifies the form of equilibration that was done. */ 00077 /* = 'N': No equilibration */ 00078 /* = 'R': Row equilibration, i.e., A has been premultiplied by 00079 */ 00080 /* diag(R). */ 00081 /* = 'C': Column equilibration, i.e., A has been postmultiplied 00082 */ 00083 /* by diag(C). */ 00084 /* = 'B': Both row and column equilibration, i.e., A has been */ 00085 /* replaced by diag(R) * A * diag(C). */ 00086 00087 /* Internal Parameters */ 00088 /* =================== */ 00089 00090 /* THRESH is a threshold value used to decide if row or column scaling */ 00091 /* should be done based on the ratio of the row or column scaling */ 00092 /* factors. If ROWCND < THRESH, row scaling is done, and if */ 00093 /* COLCND < THRESH, column scaling is done. */ 00094 00095 /* LARGE and SMALL are threshold values used to decide if row scaling */ 00096 /* should be done based on the absolute size of the largest matrix */ 00097 /* element. If AMAX > LARGE or AMAX < SMALL, row scaling is done. */ 00098 00099 /* ===================================================================== 00100 */ 00101 00102 /* .. Parameters .. */ 00103 /* .. */ 00104 /* .. Local Scalars .. */ 00105 /* .. */ 00106 /* .. External Functions .. */ 00107 /* .. */ 00108 /* .. Executable Statements .. */ 00109 00110 /* Quick return if possible */ 00111 00112 /* Parameter adjustments */ 00113 a_dim1 = *lda; 00114 a_offset = a_dim1 + 1; 00115 a -= a_offset; 00116 --r; 00117 --c; 00118 00119 /* Function Body */ 00120 if (*m <= 0 || *n <= 0) { 00121 *(unsigned char *)equed = 'N'; 00122 return 0; 00123 } 00124 00125 /* Initialize LARGE and SMALL. */ 00126 00127 small = dlamch_("Safe minimum", 12L) / dlamch_("Precision", 9L); 00128 large = 1. / small; 00129 00130 if (*rowcnd >= .1 && *amax >= small && *amax <= large) { 00131 00132 /* No row scaling */ 00133 00134 if (*colcnd >= .1) { 00135 00136 /* No column scaling */ 00137 00138 *(unsigned char *)equed = 'N'; 00139 } else { 00140 00141 /* Column scaling */ 00142 00143 i__1 = *n; 00144 for (j = 1; j <= i__1; ++j) { 00145 cj = c[j]; 00146 i__2 = *m; 00147 for (i = 1; i <= i__2; ++i) { 00148 a[i + j * a_dim1] = cj * a[i + j * a_dim1]; 00149 /* L10: */ 00150 } 00151 /* L20: */ 00152 } 00153 *(unsigned char *)equed = 'C'; 00154 } 00155 } else if (*colcnd >= .1) { 00156 00157 /* Row scaling, no column scaling */ 00158 00159 i__1 = *n; 00160 for (j = 1; j <= i__1; ++j) { 00161 i__2 = *m; 00162 for (i = 1; i <= i__2; ++i) { 00163 a[i + j * a_dim1] = r[i] * a[i + j * a_dim1]; 00164 /* L30: */ 00165 } 00166 /* L40: */ 00167 } 00168 *(unsigned char *)equed = 'R'; 00169 } else { 00170 00171 /* Row and column scaling */ 00172 00173 i__1 = *n; 00174 for (j = 1; j <= i__1; ++j) { 00175 cj = c[j]; 00176 i__2 = *m; 00177 for (i = 1; i <= i__2; ++i) { 00178 a[i + j * a_dim1] = cj * r[i] * a[i + j * a_dim1]; 00179 /* L50: */ 00180 } 00181 /* L60: */ 00182 } 00183 *(unsigned char *)equed = 'B'; 00184 } 00185 00186 return 0; 00187 00188 /* End of DLAQGE */ 00189 00190 } /* dlaqge_ */ 00191