slarrc.c
Go to the documentation of this file.
00001 /* slarrc.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 slarrc_(char *jobt, integer *n, real *vl, real *vu, real 
00017         *d__, real *e, real *pivmin, integer *eigcnt, integer *lcnt, integer *
00018         rcnt, integer *info)
00019 {
00020     /* System generated locals */
00021     integer i__1;
00022     real r__1;
00023 
00024     /* Local variables */
00025     integer i__;
00026     real sl, su, tmp, tmp2;
00027     logical matt;
00028     extern logical lsame_(char *, char *);
00029     real lpivot, rpivot;
00030 
00031 
00032 /*  -- LAPACK auxiliary routine (version 3.2) -- */
00033 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00034 /*     November 2006 */
00035 
00036 /*     .. Scalar Arguments .. */
00037 /*     .. */
00038 /*     .. Array Arguments .. */
00039 /*     .. */
00040 
00041 /*  Purpose */
00042 /*  ======= */
00043 
00044 /*  Find the number of eigenvalues of the symmetric tridiagonal matrix T */
00045 /*  that are in the interval (VL,VU] if JOBT = 'T', and of L D L^T */
00046 /*  if JOBT = 'L'. */
00047 
00048 /*  Arguments */
00049 /*  ========= */
00050 
00051 /*  JOBT    (input) CHARACTER*1 */
00052 /*          = 'T':  Compute Sturm count for matrix T. */
00053 /*          = 'L':  Compute Sturm count for matrix L D L^T. */
00054 
00055 /*  N       (input) INTEGER */
00056 /*          The order of the matrix. N > 0. */
00057 
00058 /*  VL      (input) DOUBLE PRECISION */
00059 /*  VU      (input) DOUBLE PRECISION */
00060 /*          The lower and upper bounds for the eigenvalues. */
00061 
00062 /*  D       (input) DOUBLE PRECISION array, dimension (N) */
00063 /*          JOBT = 'T': The N diagonal elements of the tridiagonal matrix T. */
00064 /*          JOBT = 'L': The N diagonal elements of the diagonal matrix D. */
00065 
00066 /*  E       (input) DOUBLE PRECISION array, dimension (N) */
00067 /*          JOBT = 'T': The N-1 offdiagonal elements of the matrix T. */
00068 /*          JOBT = 'L': The N-1 offdiagonal elements of the matrix L. */
00069 
00070 /*  PIVMIN  (input) DOUBLE PRECISION */
00071 /*          The minimum pivot in the Sturm sequence for T. */
00072 
00073 /*  EIGCNT  (output) INTEGER */
00074 /*          The number of eigenvalues of the symmetric tridiagonal matrix T */
00075 /*          that are in the interval (VL,VU] */
00076 
00077 /*  LCNT    (output) INTEGER */
00078 /*  RCNT    (output) INTEGER */
00079 /*          The left and right negcounts of the interval. */
00080 
00081 /*  INFO    (output) INTEGER */
00082 
00083 /*  Further Details */
00084 /*  =============== */
00085 
00086 /*  Based on contributions by */
00087 /*     Beresford Parlett, University of California, Berkeley, USA */
00088 /*     Jim Demmel, University of California, Berkeley, USA */
00089 /*     Inderjit Dhillon, University of Texas, Austin, USA */
00090 /*     Osni Marques, LBNL/NERSC, USA */
00091 /*     Christof Voemel, University of California, Berkeley, USA */
00092 
00093 /*  ===================================================================== */
00094 
00095 /*     .. Parameters .. */
00096 /*     .. */
00097 /*     .. Local Scalars .. */
00098 /*     .. */
00099 /*     .. External Functions .. */
00100 /*     .. */
00101 /*     .. Executable Statements .. */
00102 
00103     /* Parameter adjustments */
00104     --e;
00105     --d__;
00106 
00107     /* Function Body */
00108     *info = 0;
00109     *lcnt = 0;
00110     *rcnt = 0;
00111     *eigcnt = 0;
00112     matt = lsame_(jobt, "T");
00113     if (matt) {
00114 /*        Sturm sequence count on T */
00115         lpivot = d__[1] - *vl;
00116         rpivot = d__[1] - *vu;
00117         if (lpivot <= 0.f) {
00118             ++(*lcnt);
00119         }
00120         if (rpivot <= 0.f) {
00121             ++(*rcnt);
00122         }
00123         i__1 = *n - 1;
00124         for (i__ = 1; i__ <= i__1; ++i__) {
00125 /* Computing 2nd power */
00126             r__1 = e[i__];
00127             tmp = r__1 * r__1;
00128             lpivot = d__[i__ + 1] - *vl - tmp / lpivot;
00129             rpivot = d__[i__ + 1] - *vu - tmp / rpivot;
00130             if (lpivot <= 0.f) {
00131                 ++(*lcnt);
00132             }
00133             if (rpivot <= 0.f) {
00134                 ++(*rcnt);
00135             }
00136 /* L10: */
00137         }
00138     } else {
00139 /*        Sturm sequence count on L D L^T */
00140         sl = -(*vl);
00141         su = -(*vu);
00142         i__1 = *n - 1;
00143         for (i__ = 1; i__ <= i__1; ++i__) {
00144             lpivot = d__[i__] + sl;
00145             rpivot = d__[i__] + su;
00146             if (lpivot <= 0.f) {
00147                 ++(*lcnt);
00148             }
00149             if (rpivot <= 0.f) {
00150                 ++(*rcnt);
00151             }
00152             tmp = e[i__] * d__[i__] * e[i__];
00153 
00154             tmp2 = tmp / lpivot;
00155             if (tmp2 == 0.f) {
00156                 sl = tmp - *vl;
00157             } else {
00158                 sl = sl * tmp2 - *vl;
00159             }
00160 
00161             tmp2 = tmp / rpivot;
00162             if (tmp2 == 0.f) {
00163                 su = tmp - *vu;
00164             } else {
00165                 su = su * tmp2 - *vu;
00166             }
00167 /* L20: */
00168         }
00169         lpivot = d__[*n] + sl;
00170         rpivot = d__[*n] + su;
00171         if (lpivot <= 0.f) {
00172             ++(*lcnt);
00173         }
00174         if (rpivot <= 0.f) {
00175             ++(*rcnt);
00176         }
00177     }
00178     *eigcnt = *rcnt - *lcnt;
00179     return 0;
00180 
00181 /*     end of SLARRC */
00182 
00183 } /* slarrc_ */


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