zlaqge.c
Go to the documentation of this file.
00001 /* zlaqge.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 zlaqge_(integer *m, integer *n, doublecomplex *a, 
00017         integer *lda, doublereal *r__, doublereal *c__, doublereal *rowcnd, 
00018         doublereal *colcnd, doublereal *amax, char *equed)
00019 {
00020     /* System generated locals */
00021     integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
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 /*  ZLAQGE equilibrates a general M by N matrix A using the row and */
00044 /*  column scaling factors in the vectors R and C. */
00045 
00046 /*  Arguments */
00047 /*  ========= */
00048 
00049 /*  M       (input) INTEGER */
00050 /*          The number of rows of the matrix A.  M >= 0. */
00051 
00052 /*  N       (input) INTEGER */
00053 /*          The number of columns of the matrix A.  N >= 0. */
00054 
00055 /*  A       (input/output) COMPLEX*16 array, dimension (LDA,N) */
00056 /*          On entry, the M by N matrix A. */
00057 /*          On exit, the equilibrated matrix.  See EQUED for the form of */
00058 /*          the equilibrated matrix. */
00059 
00060 /*  LDA     (input) INTEGER */
00061 /*          The leading dimension of the array A.  LDA >= max(M,1). */
00062 
00063 /*  R       (input) DOUBLE PRECISION array, dimension (M) */
00064 /*          The row scale factors for A. */
00065 
00066 /*  C       (input) DOUBLE PRECISION array, dimension (N) */
00067 /*          The column scale factors for A. */
00068 
00069 /*  ROWCND  (input) DOUBLE PRECISION */
00070 /*          Ratio of the smallest R(i) to the largest R(i). */
00071 
00072 /*  COLCND  (input) DOUBLE PRECISION */
00073 /*          Ratio of the smallest C(i) to the largest C(i). */
00074 
00075 /*  AMAX    (input) DOUBLE PRECISION */
00076 /*          Absolute value of largest matrix entry. */
00077 
00078 /*  EQUED   (output) CHARACTER*1 */
00079 /*          Specifies the form of equilibration that was done. */
00080 /*          = 'N':  No equilibration */
00081 /*          = 'R':  Row equilibration, i.e., A has been premultiplied by */
00082 /*                  diag(R). */
00083 /*          = 'C':  Column equilibration, i.e., A has been postmultiplied */
00084 /*                  by diag(C). */
00085 /*          = 'B':  Both row and column equilibration, i.e., A has been */
00086 /*                  replaced by diag(R) * A * diag(C). */
00087 
00088 /*  Internal Parameters */
00089 /*  =================== */
00090 
00091 /*  THRESH is a threshold value used to decide if row or column scaling */
00092 /*  should be done based on the ratio of the row or column scaling */
00093 /*  factors.  If ROWCND < THRESH, row scaling is done, and if */
00094 /*  COLCND < THRESH, column scaling is done. */
00095 
00096 /*  LARGE and SMALL are threshold values used to decide if row scaling */
00097 /*  should be done based on the absolute size of the largest matrix */
00098 /*  element.  If AMAX > LARGE or AMAX < SMALL, row scaling is done. */
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 = 1 + a_dim1;
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") / dlamch_("Precision");
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                     i__3 = i__ + j * a_dim1;
00149                     i__4 = i__ + j * a_dim1;
00150                     z__1.r = cj * a[i__4].r, z__1.i = cj * a[i__4].i;
00151                     a[i__3].r = z__1.r, a[i__3].i = z__1.i;
00152 /* L10: */
00153                 }
00154 /* L20: */
00155             }
00156             *(unsigned char *)equed = 'C';
00157         }
00158     } else if (*colcnd >= .1) {
00159 
00160 /*        Row scaling, no column scaling */
00161 
00162         i__1 = *n;
00163         for (j = 1; j <= i__1; ++j) {
00164             i__2 = *m;
00165             for (i__ = 1; i__ <= i__2; ++i__) {
00166                 i__3 = i__ + j * a_dim1;
00167                 i__4 = i__;
00168                 i__5 = i__ + j * a_dim1;
00169                 z__1.r = r__[i__4] * a[i__5].r, z__1.i = r__[i__4] * a[i__5]
00170                         .i;
00171                 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
00172 /* L30: */
00173             }
00174 /* L40: */
00175         }
00176         *(unsigned char *)equed = 'R';
00177     } else {
00178 
00179 /*        Row and column scaling */
00180 
00181         i__1 = *n;
00182         for (j = 1; j <= i__1; ++j) {
00183             cj = c__[j];
00184             i__2 = *m;
00185             for (i__ = 1; i__ <= i__2; ++i__) {
00186                 i__3 = i__ + j * a_dim1;
00187                 d__1 = cj * r__[i__];
00188                 i__4 = i__ + j * a_dim1;
00189                 z__1.r = d__1 * a[i__4].r, z__1.i = d__1 * a[i__4].i;
00190                 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
00191 /* L50: */
00192             }
00193 /* L60: */
00194         }
00195         *(unsigned char *)equed = 'B';
00196     }
00197 
00198     return 0;
00199 
00200 /*     End of ZLAQGE */
00201 
00202 } /* zlaqge_ */


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