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


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:56:11