Add graph references
This commit is contained in:
Abdelrahman Said
+545
@@ -0,0 +1,545 @@
|
||||
/* -- translated by f2c (version 20240504).
|
||||
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 "f2c.h"
|
||||
|
||||
/* > \brief \b DLAR1V computes the (scaled) r-th column of the inverse of the submatrix in rows b1 through bn
|
||||
of the tridiagonal matrix LDLT - λI.
|
||||
|
||||
=========== DOCUMENTATION ===========
|
||||
|
||||
Online html documentation available at
|
||||
http://www.netlib.org/lapack/explore-html/
|
||||
|
||||
> \htmlonly
|
||||
> Download DLAR1V + dependencies
|
||||
> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlar1v.
|
||||
f">
|
||||
> [TGZ]</a>
|
||||
> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlar1v.
|
||||
f">
|
||||
> [ZIP]</a>
|
||||
> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlar1v.
|
||||
f">
|
||||
> [TXT]</a>
|
||||
> \endhtmlonly
|
||||
|
||||
Definition:
|
||||
===========
|
||||
|
||||
SUBROUTINE DLAR1V( N, B1, BN, LAMBDA, D, L, LD, LLD,
|
||||
PIVMIN, GAPTOL, Z, WANTNC, NEGCNT, ZTZ, MINGMA,
|
||||
R, ISUPPZ, NRMINV, RESID, RQCORR, WORK )
|
||||
|
||||
LOGICAL WANTNC
|
||||
INTEGER B1, BN, N, NEGCNT, R
|
||||
DOUBLE PRECISION GAPTOL, LAMBDA, MINGMA, NRMINV, PIVMIN, RESID,
|
||||
$ RQCORR, ZTZ
|
||||
INTEGER ISUPPZ( * )
|
||||
DOUBLE PRECISION D( * ), L( * ), LD( * ), LLD( * ),
|
||||
$ WORK( * )
|
||||
DOUBLE PRECISION Z( * )
|
||||
|
||||
|
||||
> \par Purpose:
|
||||
=============
|
||||
>
|
||||
> \verbatim
|
||||
>
|
||||
> DLAR1V computes the (scaled) r-th column of the inverse of
|
||||
> the sumbmatrix in rows B1 through BN of the tridiagonal matrix
|
||||
> L D L**T - sigma I. When sigma is close to an eigenvalue, the
|
||||
> computed vector is an accurate eigenvector. Usually, r corresponds
|
||||
> to the index where the eigenvector is largest in magnitude.
|
||||
> The following steps accomplish this computation :
|
||||
> (a) Stationary qd transform, L D L**T - sigma I = L(+) D(+) L(+)**T,
|
||||
> (b) Progressive qd transform, L D L**T - sigma I = U(-) D(-) U(-)**T,
|
||||
> (c) Computation of the diagonal elements of the inverse of
|
||||
> L D L**T - sigma I by combining the above transforms, and choosing
|
||||
> r as the index where the diagonal of the inverse is (one of the)
|
||||
> largest in magnitude.
|
||||
> (d) Computation of the (scaled) r-th column of the inverse using the
|
||||
> twisted factorization obtained by combining the top part of the
|
||||
> the stationary and the bottom part of the progressive transform.
|
||||
> \endverbatim
|
||||
|
||||
Arguments:
|
||||
==========
|
||||
|
||||
> \param[in] N
|
||||
> \verbatim
|
||||
> N is INTEGER
|
||||
> The order of the matrix L D L**T.
|
||||
> \endverbatim
|
||||
>
|
||||
> \param[in] B1
|
||||
> \verbatim
|
||||
> B1 is INTEGER
|
||||
> First index of the submatrix of L D L**T.
|
||||
> \endverbatim
|
||||
>
|
||||
> \param[in] BN
|
||||
> \verbatim
|
||||
> BN is INTEGER
|
||||
> Last index of the submatrix of L D L**T.
|
||||
> \endverbatim
|
||||
>
|
||||
> \param[in] LAMBDA
|
||||
> \verbatim
|
||||
> LAMBDA is DOUBLE PRECISION
|
||||
> The shift. In order to compute an accurate eigenvector,
|
||||
> LAMBDA should be a good approximation to an eigenvalue
|
||||
> of L D L**T.
|
||||
> \endverbatim
|
||||
>
|
||||
> \param[in] L
|
||||
> \verbatim
|
||||
> L is DOUBLE PRECISION array, dimension (N-1)
|
||||
> The (n-1) subdiagonal elements of the unit bidiagonal matrix
|
||||
> L, in elements 1 to N-1.
|
||||
> \endverbatim
|
||||
>
|
||||
> \param[in] D
|
||||
> \verbatim
|
||||
> D is DOUBLE PRECISION array, dimension (N)
|
||||
> The n diagonal elements of the diagonal matrix D.
|
||||
> \endverbatim
|
||||
>
|
||||
> \param[in] LD
|
||||
> \verbatim
|
||||
> LD is DOUBLE PRECISION array, dimension (N-1)
|
||||
> The n-1 elements L(i)*D(i).
|
||||
> \endverbatim
|
||||
>
|
||||
> \param[in] LLD
|
||||
> \verbatim
|
||||
> LLD is DOUBLE PRECISION array, dimension (N-1)
|
||||
> The n-1 elements L(i)*L(i)*D(i).
|
||||
> \endverbatim
|
||||
>
|
||||
> \param[in] PIVMIN
|
||||
> \verbatim
|
||||
> PIVMIN is DOUBLE PRECISION
|
||||
> The minimum pivot in the Sturm sequence.
|
||||
> \endverbatim
|
||||
>
|
||||
> \param[in] GAPTOL
|
||||
> \verbatim
|
||||
> GAPTOL is DOUBLE PRECISION
|
||||
> Tolerance that indicates when eigenvector entries are negligible
|
||||
> w.r.t. their contribution to the residual.
|
||||
> \endverbatim
|
||||
>
|
||||
> \param[in,out] Z
|
||||
> \verbatim
|
||||
> Z is DOUBLE PRECISION array, dimension (N)
|
||||
> On input, all entries of Z must be set to 0.
|
||||
> On output, Z contains the (scaled) r-th column of the
|
||||
> inverse. The scaling is such that Z(R) equals 1.
|
||||
> \endverbatim
|
||||
>
|
||||
> \param[in] WANTNC
|
||||
> \verbatim
|
||||
> WANTNC is LOGICAL
|
||||
> Specifies whether NEGCNT has to be computed.
|
||||
> \endverbatim
|
||||
>
|
||||
> \param[out] NEGCNT
|
||||
> \verbatim
|
||||
> NEGCNT is INTEGER
|
||||
> If WANTNC is .TRUE. then NEGCNT = the number of pivots < pivmin
|
||||
> in the matrix factorization L D L**T, and NEGCNT = -1 otherwise.
|
||||
> \endverbatim
|
||||
>
|
||||
> \param[out] ZTZ
|
||||
> \verbatim
|
||||
> ZTZ is DOUBLE PRECISION
|
||||
> The square of the 2-norm of Z.
|
||||
> \endverbatim
|
||||
>
|
||||
> \param[out] MINGMA
|
||||
> \verbatim
|
||||
> MINGMA is DOUBLE PRECISION
|
||||
> The reciprocal of the largest (in magnitude) diagonal
|
||||
> element of the inverse of L D L**T - sigma I.
|
||||
> \endverbatim
|
||||
>
|
||||
> \param[in,out] R
|
||||
> \verbatim
|
||||
> R is INTEGER
|
||||
> The twist index for the twisted factorization used to
|
||||
> compute Z.
|
||||
> On input, 0 <= R <= N. If R is input as 0, R is set to
|
||||
> the index where (L D L**T - sigma I)^{-1} is largest
|
||||
> in magnitude. If 1 <= R <= N, R is unchanged.
|
||||
> On output, R contains the twist index used to compute Z.
|
||||
> Ideally, R designates the position of the maximum entry in the
|
||||
> eigenvector.
|
||||
> \endverbatim
|
||||
>
|
||||
> \param[out] ISUPPZ
|
||||
> \verbatim
|
||||
> ISUPPZ is INTEGER array, dimension (2)
|
||||
> The support of the vector in Z, i.e., the vector Z is
|
||||
> nonzero only in elements ISUPPZ(1) through ISUPPZ( 2 ).
|
||||
> \endverbatim
|
||||
>
|
||||
> \param[out] NRMINV
|
||||
> \verbatim
|
||||
> NRMINV is DOUBLE PRECISION
|
||||
> NRMINV = 1/SQRT( ZTZ )
|
||||
> \endverbatim
|
||||
>
|
||||
> \param[out] RESID
|
||||
> \verbatim
|
||||
> RESID is DOUBLE PRECISION
|
||||
> The residual of the FP vector.
|
||||
> RESID = ABS( MINGMA )/SQRT( ZTZ )
|
||||
> \endverbatim
|
||||
>
|
||||
> \param[out] RQCORR
|
||||
> \verbatim
|
||||
> RQCORR is DOUBLE PRECISION
|
||||
> The Rayleigh Quotient correction to LAMBDA.
|
||||
> RQCORR = MINGMA*TMP
|
||||
> \endverbatim
|
||||
>
|
||||
> \param[out] WORK
|
||||
> \verbatim
|
||||
> WORK is DOUBLE PRECISION array, dimension (4*N)
|
||||
> \endverbatim
|
||||
|
||||
Authors:
|
||||
========
|
||||
|
||||
> \author Univ. of Tennessee
|
||||
> \author Univ. of California Berkeley
|
||||
> \author Univ. of Colorado Denver
|
||||
> \author NAG Ltd.
|
||||
|
||||
> \date September 2012
|
||||
|
||||
> \ingroup doubleOTHERauxiliary
|
||||
|
||||
> \par Contributors:
|
||||
==================
|
||||
>
|
||||
> Beresford Parlett, University of California, Berkeley, USA \n
|
||||
> Jim Demmel, University of California, Berkeley, USA \n
|
||||
> Inderjit Dhillon, University of Texas, Austin, USA \n
|
||||
> Osni Marques, LBNL/NERSC, USA \n
|
||||
> Christof Voemel, University of California, Berkeley, USA
|
||||
|
||||
=====================================================================
|
||||
Subroutine */ int igraphdlar1v_(integer *n, integer *b1, integer *bn, doublereal
|
||||
*lambda, doublereal *d__, doublereal *l, doublereal *ld, doublereal *
|
||||
lld, doublereal *pivmin, doublereal *gaptol, doublereal *z__, logical
|
||||
*wantnc, integer *negcnt, doublereal *ztz, doublereal *mingma,
|
||||
integer *r__, integer *isuppz, doublereal *nrminv, doublereal *resid,
|
||||
doublereal *rqcorr, doublereal *work)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer i__1;
|
||||
doublereal d__1, d__2, d__3;
|
||||
|
||||
/* Builtin functions */
|
||||
double sqrt(doublereal);
|
||||
|
||||
/* Local variables */
|
||||
integer i__;
|
||||
doublereal s;
|
||||
integer r1, r2;
|
||||
doublereal eps, tmp;
|
||||
integer neg1, neg2, indp, inds;
|
||||
doublereal dplus;
|
||||
extern doublereal igraphdlamch_(char *);
|
||||
extern logical igraphdisnan_(doublereal *);
|
||||
integer indlpl, indumn;
|
||||
doublereal dminus;
|
||||
logical sawnan1, sawnan2;
|
||||
|
||||
|
||||
/* -- LAPACK auxiliary routine (version 3.4.2) --
|
||||
-- LAPACK is a software package provided by Univ. of Tennessee, --
|
||||
-- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
|
||||
September 2012
|
||||
|
||||
|
||||
=====================================================================
|
||||
|
||||
|
||||
Parameter adjustments */
|
||||
--work;
|
||||
--isuppz;
|
||||
--z__;
|
||||
--lld;
|
||||
--ld;
|
||||
--l;
|
||||
--d__;
|
||||
|
||||
/* Function Body */
|
||||
eps = igraphdlamch_("Precision");
|
||||
if (*r__ == 0) {
|
||||
r1 = *b1;
|
||||
r2 = *bn;
|
||||
} else {
|
||||
r1 = *r__;
|
||||
r2 = *r__;
|
||||
}
|
||||
/* Storage for LPLUS */
|
||||
indlpl = 0;
|
||||
/* Storage for UMINUS */
|
||||
indumn = *n;
|
||||
inds = (*n << 1) + 1;
|
||||
indp = *n * 3 + 1;
|
||||
if (*b1 == 1) {
|
||||
work[inds] = 0.;
|
||||
} else {
|
||||
work[inds + *b1 - 1] = lld[*b1 - 1];
|
||||
}
|
||||
|
||||
/* Compute the stationary transform (using the differential form)
|
||||
until the index R2. */
|
||||
|
||||
sawnan1 = FALSE_;
|
||||
neg1 = 0;
|
||||
s = work[inds + *b1 - 1] - *lambda;
|
||||
i__1 = r1 - 1;
|
||||
for (i__ = *b1; i__ <= i__1; ++i__) {
|
||||
dplus = d__[i__] + s;
|
||||
work[indlpl + i__] = ld[i__] / dplus;
|
||||
if (dplus < 0.) {
|
||||
++neg1;
|
||||
}
|
||||
work[inds + i__] = s * work[indlpl + i__] * l[i__];
|
||||
s = work[inds + i__] - *lambda;
|
||||
/* L50: */
|
||||
}
|
||||
sawnan1 = igraphdisnan_(&s);
|
||||
if (sawnan1) {
|
||||
goto L60;
|
||||
}
|
||||
i__1 = r2 - 1;
|
||||
for (i__ = r1; i__ <= i__1; ++i__) {
|
||||
dplus = d__[i__] + s;
|
||||
work[indlpl + i__] = ld[i__] / dplus;
|
||||
work[inds + i__] = s * work[indlpl + i__] * l[i__];
|
||||
s = work[inds + i__] - *lambda;
|
||||
/* L51: */
|
||||
}
|
||||
sawnan1 = igraphdisnan_(&s);
|
||||
|
||||
L60:
|
||||
if (sawnan1) {
|
||||
/* Runs a slower version of the above loop if a NaN is detected */
|
||||
neg1 = 0;
|
||||
s = work[inds + *b1 - 1] - *lambda;
|
||||
i__1 = r1 - 1;
|
||||
for (i__ = *b1; i__ <= i__1; ++i__) {
|
||||
dplus = d__[i__] + s;
|
||||
if (abs(dplus) < *pivmin) {
|
||||
dplus = -(*pivmin);
|
||||
}
|
||||
work[indlpl + i__] = ld[i__] / dplus;
|
||||
if (dplus < 0.) {
|
||||
++neg1;
|
||||
}
|
||||
work[inds + i__] = s * work[indlpl + i__] * l[i__];
|
||||
if (work[indlpl + i__] == 0.) {
|
||||
work[inds + i__] = lld[i__];
|
||||
}
|
||||
s = work[inds + i__] - *lambda;
|
||||
/* L70: */
|
||||
}
|
||||
i__1 = r2 - 1;
|
||||
for (i__ = r1; i__ <= i__1; ++i__) {
|
||||
dplus = d__[i__] + s;
|
||||
if (abs(dplus) < *pivmin) {
|
||||
dplus = -(*pivmin);
|
||||
}
|
||||
work[indlpl + i__] = ld[i__] / dplus;
|
||||
work[inds + i__] = s * work[indlpl + i__] * l[i__];
|
||||
if (work[indlpl + i__] == 0.) {
|
||||
work[inds + i__] = lld[i__];
|
||||
}
|
||||
s = work[inds + i__] - *lambda;
|
||||
/* L71: */
|
||||
}
|
||||
}
|
||||
|
||||
/* Compute the progressive transform (using the differential form)
|
||||
until the index R1 */
|
||||
|
||||
sawnan2 = FALSE_;
|
||||
neg2 = 0;
|
||||
work[indp + *bn - 1] = d__[*bn] - *lambda;
|
||||
i__1 = r1;
|
||||
for (i__ = *bn - 1; i__ >= i__1; --i__) {
|
||||
dminus = lld[i__] + work[indp + i__];
|
||||
tmp = d__[i__] / dminus;
|
||||
if (dminus < 0.) {
|
||||
++neg2;
|
||||
}
|
||||
work[indumn + i__] = l[i__] * tmp;
|
||||
work[indp + i__ - 1] = work[indp + i__] * tmp - *lambda;
|
||||
/* L80: */
|
||||
}
|
||||
tmp = work[indp + r1 - 1];
|
||||
sawnan2 = igraphdisnan_(&tmp);
|
||||
if (sawnan2) {
|
||||
/* Runs a slower version of the above loop if a NaN is detected */
|
||||
neg2 = 0;
|
||||
i__1 = r1;
|
||||
for (i__ = *bn - 1; i__ >= i__1; --i__) {
|
||||
dminus = lld[i__] + work[indp + i__];
|
||||
if (abs(dminus) < *pivmin) {
|
||||
dminus = -(*pivmin);
|
||||
}
|
||||
tmp = d__[i__] / dminus;
|
||||
if (dminus < 0.) {
|
||||
++neg2;
|
||||
}
|
||||
work[indumn + i__] = l[i__] * tmp;
|
||||
work[indp + i__ - 1] = work[indp + i__] * tmp - *lambda;
|
||||
if (tmp == 0.) {
|
||||
work[indp + i__ - 1] = d__[i__] - *lambda;
|
||||
}
|
||||
/* L100: */
|
||||
}
|
||||
}
|
||||
|
||||
/* Find the index (from R1 to R2) of the largest (in magnitude)
|
||||
diagonal element of the inverse */
|
||||
|
||||
*mingma = work[inds + r1 - 1] + work[indp + r1 - 1];
|
||||
if (*mingma < 0.) {
|
||||
++neg1;
|
||||
}
|
||||
if (*wantnc) {
|
||||
*negcnt = neg1 + neg2;
|
||||
} else {
|
||||
*negcnt = -1;
|
||||
}
|
||||
if (abs(*mingma) == 0.) {
|
||||
*mingma = eps * work[inds + r1 - 1];
|
||||
}
|
||||
*r__ = r1;
|
||||
i__1 = r2 - 1;
|
||||
for (i__ = r1; i__ <= i__1; ++i__) {
|
||||
tmp = work[inds + i__] + work[indp + i__];
|
||||
if (tmp == 0.) {
|
||||
tmp = eps * work[inds + i__];
|
||||
}
|
||||
if (abs(tmp) <= abs(*mingma)) {
|
||||
*mingma = tmp;
|
||||
*r__ = i__ + 1;
|
||||
}
|
||||
/* L110: */
|
||||
}
|
||||
|
||||
/* Compute the FP vector: solve N^T v = e_r */
|
||||
|
||||
isuppz[1] = *b1;
|
||||
isuppz[2] = *bn;
|
||||
z__[*r__] = 1.;
|
||||
*ztz = 1.;
|
||||
|
||||
/* Compute the FP vector upwards from R */
|
||||
|
||||
if (! sawnan1 && ! sawnan2) {
|
||||
i__1 = *b1;
|
||||
for (i__ = *r__ - 1; i__ >= i__1; --i__) {
|
||||
z__[i__] = -(work[indlpl + i__] * z__[i__ + 1]);
|
||||
if (((d__1 = z__[i__], abs(d__1)) + (d__2 = z__[i__ + 1], abs(
|
||||
d__2))) * (d__3 = ld[i__], abs(d__3)) < *gaptol) {
|
||||
z__[i__] = 0.;
|
||||
isuppz[1] = i__ + 1;
|
||||
goto L220;
|
||||
}
|
||||
*ztz += z__[i__] * z__[i__];
|
||||
/* L210: */
|
||||
}
|
||||
L220:
|
||||
;
|
||||
} else {
|
||||
/* Run slower loop if NaN occurred. */
|
||||
i__1 = *b1;
|
||||
for (i__ = *r__ - 1; i__ >= i__1; --i__) {
|
||||
if (z__[i__ + 1] == 0.) {
|
||||
z__[i__] = -(ld[i__ + 1] / ld[i__]) * z__[i__ + 2];
|
||||
} else {
|
||||
z__[i__] = -(work[indlpl + i__] * z__[i__ + 1]);
|
||||
}
|
||||
if (((d__1 = z__[i__], abs(d__1)) + (d__2 = z__[i__ + 1], abs(
|
||||
d__2))) * (d__3 = ld[i__], abs(d__3)) < *gaptol) {
|
||||
z__[i__] = 0.;
|
||||
isuppz[1] = i__ + 1;
|
||||
goto L240;
|
||||
}
|
||||
*ztz += z__[i__] * z__[i__];
|
||||
/* L230: */
|
||||
}
|
||||
L240:
|
||||
;
|
||||
}
|
||||
/* Compute the FP vector downwards from R in blocks of size BLKSIZ */
|
||||
if (! sawnan1 && ! sawnan2) {
|
||||
i__1 = *bn - 1;
|
||||
for (i__ = *r__; i__ <= i__1; ++i__) {
|
||||
z__[i__ + 1] = -(work[indumn + i__] * z__[i__]);
|
||||
if (((d__1 = z__[i__], abs(d__1)) + (d__2 = z__[i__ + 1], abs(
|
||||
d__2))) * (d__3 = ld[i__], abs(d__3)) < *gaptol) {
|
||||
z__[i__ + 1] = 0.;
|
||||
isuppz[2] = i__;
|
||||
goto L260;
|
||||
}
|
||||
*ztz += z__[i__ + 1] * z__[i__ + 1];
|
||||
/* L250: */
|
||||
}
|
||||
L260:
|
||||
;
|
||||
} else {
|
||||
/* Run slower loop if NaN occurred. */
|
||||
i__1 = *bn - 1;
|
||||
for (i__ = *r__; i__ <= i__1; ++i__) {
|
||||
if (z__[i__] == 0.) {
|
||||
z__[i__ + 1] = -(ld[i__ - 1] / ld[i__]) * z__[i__ - 1];
|
||||
} else {
|
||||
z__[i__ + 1] = -(work[indumn + i__] * z__[i__]);
|
||||
}
|
||||
if (((d__1 = z__[i__], abs(d__1)) + (d__2 = z__[i__ + 1], abs(
|
||||
d__2))) * (d__3 = ld[i__], abs(d__3)) < *gaptol) {
|
||||
z__[i__ + 1] = 0.;
|
||||
isuppz[2] = i__;
|
||||
goto L280;
|
||||
}
|
||||
*ztz += z__[i__ + 1] * z__[i__ + 1];
|
||||
/* L270: */
|
||||
}
|
||||
L280:
|
||||
;
|
||||
}
|
||||
|
||||
/* Compute quantities for convergence test */
|
||||
|
||||
tmp = 1. / *ztz;
|
||||
*nrminv = sqrt(tmp);
|
||||
*resid = abs(*mingma) * *nrminv;
|
||||
*rqcorr = *mingma * tmp;
|
||||
|
||||
|
||||
return 0;
|
||||
|
||||
/* End of DLAR1V */
|
||||
|
||||
} /* igraphdlar1v_ */
|
||||
|
||||
Reference in New Issue
Block a user