mirror of https://github.com/opencv/opencv.git
Open Source Computer Vision Library
https://opencv.org/
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
183 lines
4.6 KiB
183 lines
4.6 KiB
/* slarrc.f -- translated by f2c (version 20061008). |
|
You must link the resulting object file with libf2c: |
|
on Microsoft Windows system, link with libf2c.lib; |
|
on Linux or Unix systems, link with .../path/to/libf2c.a -lm |
|
or, if you install libf2c.a in a standard place, with -lf2c -lm |
|
-- in that order, at the end of the command line, as in |
|
cc *.o -lf2c -lm |
|
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., |
|
|
|
http://www.netlib.org/f2c/libf2c.zip |
|
*/ |
|
|
|
#include "clapack.h" |
|
|
|
|
|
/* Subroutine */ int slarrc_(char *jobt, integer *n, real *vl, real *vu, real |
|
*d__, real *e, real *pivmin, integer *eigcnt, integer *lcnt, integer * |
|
rcnt, integer *info) |
|
{ |
|
/* System generated locals */ |
|
integer i__1; |
|
real r__1; |
|
|
|
/* Local variables */ |
|
integer i__; |
|
real sl, su, tmp, tmp2; |
|
logical matt; |
|
extern logical lsame_(char *, char *); |
|
real lpivot, rpivot; |
|
|
|
|
|
/* -- LAPACK auxiliary routine (version 3.2) -- */ |
|
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ |
|
/* November 2006 */ |
|
|
|
/* .. Scalar Arguments .. */ |
|
/* .. */ |
|
/* .. Array Arguments .. */ |
|
/* .. */ |
|
|
|
/* Purpose */ |
|
/* ======= */ |
|
|
|
/* Find the number of eigenvalues of the symmetric tridiagonal matrix T */ |
|
/* that are in the interval (VL,VU] if JOBT = 'T', and of L D L^T */ |
|
/* if JOBT = 'L'. */ |
|
|
|
/* Arguments */ |
|
/* ========= */ |
|
|
|
/* JOBT (input) CHARACTER*1 */ |
|
/* = 'T': Compute Sturm count for matrix T. */ |
|
/* = 'L': Compute Sturm count for matrix L D L^T. */ |
|
|
|
/* N (input) INTEGER */ |
|
/* The order of the matrix. N > 0. */ |
|
|
|
/* VL (input) DOUBLE PRECISION */ |
|
/* VU (input) DOUBLE PRECISION */ |
|
/* The lower and upper bounds for the eigenvalues. */ |
|
|
|
/* D (input) DOUBLE PRECISION array, dimension (N) */ |
|
/* JOBT = 'T': The N diagonal elements of the tridiagonal matrix T. */ |
|
/* JOBT = 'L': The N diagonal elements of the diagonal matrix D. */ |
|
|
|
/* E (input) DOUBLE PRECISION array, dimension (N) */ |
|
/* JOBT = 'T': The N-1 offdiagonal elements of the matrix T. */ |
|
/* JOBT = 'L': The N-1 offdiagonal elements of the matrix L. */ |
|
|
|
/* PIVMIN (input) DOUBLE PRECISION */ |
|
/* The minimum pivot in the Sturm sequence for T. */ |
|
|
|
/* EIGCNT (output) INTEGER */ |
|
/* The number of eigenvalues of the symmetric tridiagonal matrix T */ |
|
/* that are in the interval (VL,VU] */ |
|
|
|
/* LCNT (output) INTEGER */ |
|
/* RCNT (output) INTEGER */ |
|
/* The left and right negcounts of the interval. */ |
|
|
|
/* INFO (output) INTEGER */ |
|
|
|
/* Further Details */ |
|
/* =============== */ |
|
|
|
/* Based on contributions by */ |
|
/* Beresford Parlett, University of California, Berkeley, USA */ |
|
/* Jim Demmel, University of California, Berkeley, USA */ |
|
/* Inderjit Dhillon, University of Texas, Austin, USA */ |
|
/* Osni Marques, LBNL/NERSC, USA */ |
|
/* Christof Voemel, University of California, Berkeley, USA */ |
|
|
|
/* ===================================================================== */ |
|
|
|
/* .. Parameters .. */ |
|
/* .. */ |
|
/* .. Local Scalars .. */ |
|
/* .. */ |
|
/* .. External Functions .. */ |
|
/* .. */ |
|
/* .. Executable Statements .. */ |
|
|
|
/* Parameter adjustments */ |
|
--e; |
|
--d__; |
|
|
|
/* Function Body */ |
|
*info = 0; |
|
*lcnt = 0; |
|
*rcnt = 0; |
|
*eigcnt = 0; |
|
matt = lsame_(jobt, "T"); |
|
if (matt) { |
|
/* Sturm sequence count on T */ |
|
lpivot = d__[1] - *vl; |
|
rpivot = d__[1] - *vu; |
|
if (lpivot <= 0.f) { |
|
++(*lcnt); |
|
} |
|
if (rpivot <= 0.f) { |
|
++(*rcnt); |
|
} |
|
i__1 = *n - 1; |
|
for (i__ = 1; i__ <= i__1; ++i__) { |
|
/* Computing 2nd power */ |
|
r__1 = e[i__]; |
|
tmp = r__1 * r__1; |
|
lpivot = d__[i__ + 1] - *vl - tmp / lpivot; |
|
rpivot = d__[i__ + 1] - *vu - tmp / rpivot; |
|
if (lpivot <= 0.f) { |
|
++(*lcnt); |
|
} |
|
if (rpivot <= 0.f) { |
|
++(*rcnt); |
|
} |
|
/* L10: */ |
|
} |
|
} else { |
|
/* Sturm sequence count on L D L^T */ |
|
sl = -(*vl); |
|
su = -(*vu); |
|
i__1 = *n - 1; |
|
for (i__ = 1; i__ <= i__1; ++i__) { |
|
lpivot = d__[i__] + sl; |
|
rpivot = d__[i__] + su; |
|
if (lpivot <= 0.f) { |
|
++(*lcnt); |
|
} |
|
if (rpivot <= 0.f) { |
|
++(*rcnt); |
|
} |
|
tmp = e[i__] * d__[i__] * e[i__]; |
|
|
|
tmp2 = tmp / lpivot; |
|
if (tmp2 == 0.f) { |
|
sl = tmp - *vl; |
|
} else { |
|
sl = sl * tmp2 - *vl; |
|
} |
|
|
|
tmp2 = tmp / rpivot; |
|
if (tmp2 == 0.f) { |
|
su = tmp - *vu; |
|
} else { |
|
su = su * tmp2 - *vu; |
|
} |
|
/* L20: */ |
|
} |
|
lpivot = d__[*n] + sl; |
|
rpivot = d__[*n] + su; |
|
if (lpivot <= 0.f) { |
|
++(*lcnt); |
|
} |
|
if (rpivot <= 0.f) { |
|
++(*rcnt); |
|
} |
|
} |
|
*eigcnt = *rcnt - *lcnt; |
|
return 0; |
|
|
|
/* end of SLARRC */ |
|
|
|
} /* slarrc_ */
|
|
|