slaqsy.c
Go to the documentation of this file.
00001 /* slaqsy.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 slaqsy_(char *uplo, integer *n, real *a, integer *lda, 
00017         real *s, real *scond, real *amax, char *equed)
00018 {
00019     /* System generated locals */
00020     integer a_dim1, a_offset, i__1, i__2;
00021 
00022     /* Local variables */
00023     integer i__, j;
00024     real cj, large;
00025     extern logical lsame_(char *, char *);
00026     real small;
00027     extern doublereal slamch_(char *);
00028 
00029 
00030 /*  -- LAPACK auxiliary routine (version 3.2) -- */
00031 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00032 /*     November 2006 */
00033 
00034 /*     .. Scalar Arguments .. */
00035 /*     .. */
00036 /*     .. Array Arguments .. */
00037 /*     .. */
00038 
00039 /*  Purpose */
00040 /*  ======= */
00041 
00042 /*  SLAQSY equilibrates a symmetric matrix A using the scaling factors */
00043 /*  in the vector S. */
00044 
00045 /*  Arguments */
00046 /*  ========= */
00047 
00048 /*  UPLO    (input) CHARACTER*1 */
00049 /*          Specifies whether the upper or lower triangular part of the */
00050 /*          symmetric matrix A is stored. */
00051 /*          = 'U':  Upper triangular */
00052 /*          = 'L':  Lower triangular */
00053 
00054 /*  N       (input) INTEGER */
00055 /*          The order of the matrix A.  N >= 0. */
00056 
00057 /*  A       (input/output) REAL array, dimension (LDA,N) */
00058 /*          On entry, the symmetric matrix A.  If UPLO = 'U', the leading */
00059 /*          n by n upper triangular part of A contains the upper */
00060 /*          triangular part of the matrix A, and the strictly lower */
00061 /*          triangular part of A is not referenced.  If UPLO = 'L', the */
00062 /*          leading n by n lower triangular part of A contains the lower */
00063 /*          triangular part of the matrix A, and the strictly upper */
00064 /*          triangular part of A is not referenced. */
00065 
00066 /*          On exit, if EQUED = 'Y', the equilibrated matrix: */
00067 /*          diag(S) * A * diag(S). */
00068 
00069 /*  LDA     (input) INTEGER */
00070 /*          The leading dimension of the array A.  LDA >= max(N,1). */
00071 
00072 /*  S       (input) REAL array, dimension (N) */
00073 /*          The scale factors for A. */
00074 
00075 /*  SCOND   (input) REAL */
00076 /*          Ratio of the smallest S(i) to the largest S(i). */
00077 
00078 /*  AMAX    (input) REAL */
00079 /*          Absolute value of largest matrix entry. */
00080 
00081 /*  EQUED   (output) CHARACTER*1 */
00082 /*          Specifies whether or not equilibration was done. */
00083 /*          = 'N':  No equilibration. */
00084 /*          = 'Y':  Equilibration was done, i.e., A has been replaced by */
00085 /*                  diag(S) * A * diag(S). */
00086 
00087 /*  Internal Parameters */
00088 /*  =================== */
00089 
00090 /*  THRESH is a threshold value used to decide if scaling should be done */
00091 /*  based on the ratio of the scaling factors.  If SCOND < THRESH, */
00092 /*  scaling is done. */
00093 
00094 /*  LARGE and SMALL are threshold values used to decide if scaling should */
00095 /*  be done based on the absolute size of the largest matrix element. */
00096 /*  If AMAX > LARGE or AMAX < SMALL, scaling is done. */
00097 
00098 /*  ===================================================================== */
00099 
00100 /*     .. Parameters .. */
00101 /*     .. */
00102 /*     .. Local Scalars .. */
00103 /*     .. */
00104 /*     .. External Functions .. */
00105 /*     .. */
00106 /*     .. Executable Statements .. */
00107 
00108 /*     Quick return if possible */
00109 
00110     /* Parameter adjustments */
00111     a_dim1 = *lda;
00112     a_offset = 1 + a_dim1;
00113     a -= a_offset;
00114     --s;
00115 
00116     /* Function Body */
00117     if (*n <= 0) {
00118         *(unsigned char *)equed = 'N';
00119         return 0;
00120     }
00121 
00122 /*     Initialize LARGE and SMALL. */
00123 
00124     small = slamch_("Safe minimum") / slamch_("Precision");
00125     large = 1.f / small;
00126 
00127     if (*scond >= .1f && *amax >= small && *amax <= large) {
00128 
00129 /*        No equilibration */
00130 
00131         *(unsigned char *)equed = 'N';
00132     } else {
00133 
00134 /*        Replace A by diag(S) * A * diag(S). */
00135 
00136         if (lsame_(uplo, "U")) {
00137 
00138 /*           Upper triangle of A is stored. */
00139 
00140             i__1 = *n;
00141             for (j = 1; j <= i__1; ++j) {
00142                 cj = s[j];
00143                 i__2 = j;
00144                 for (i__ = 1; i__ <= i__2; ++i__) {
00145                     a[i__ + j * a_dim1] = cj * s[i__] * a[i__ + j * a_dim1];
00146 /* L10: */
00147                 }
00148 /* L20: */
00149             }
00150         } else {
00151 
00152 /*           Lower triangle of A is stored. */
00153 
00154             i__1 = *n;
00155             for (j = 1; j <= i__1; ++j) {
00156                 cj = s[j];
00157                 i__2 = *n;
00158                 for (i__ = j; i__ <= i__2; ++i__) {
00159                     a[i__ + j * a_dim1] = cj * s[i__] * a[i__ + j * a_dim1];
00160 /* L30: */
00161                 }
00162 /* L40: */
00163             }
00164         }
00165         *(unsigned char *)equed = 'Y';
00166     }
00167 
00168     return 0;
00169 
00170 /*     End of SLAQSY */
00171 
00172 } /* slaqsy_ */


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