Subroutine */ int igraphdsaup2_(integer *ido, char *bmat, integer *n, char *
which, integer *nev, integer *np, doublereal *tol, doublereal *resid,
integer *mode, integer *iupd, integer *ishift, integer *mxiter,
doublereal *v, integer *ldv, doublereal *h__, integer *ldh,
doublereal *ritz, doublereal *bounds, doublereal *q, integer *ldq,
doublereal *workl, integer *ipntr, doublereal *workd, integer *info)
{
/* System generated locals */
integer h_dim1, h_offset, q_dim1, q_offset, v_dim1, v_offset, i__1, i__2,
i__3;
doublereal d__1, d__2, d__3;
/* Builtin functions */
double pow_dd(doublereal *, doublereal *);
integer s_cmp(char *, char *, ftnlen, ftnlen);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
double sqrt(doublereal);
/* Local variables */
integer j;
real t0, t1, t2, t3;
integer kp[3];
IGRAPH_F77_SAVE integer np0;
integer nbx = 0;
IGRAPH_F77_SAVE integer nev0;
extern doublereal igraphddot_(integer *, doublereal *, integer *, doublereal *,
integer *);
IGRAPH_F77_SAVE doublereal eps23;
integer ierr;
IGRAPH_F77_SAVE integer iter;
doublereal temp;
integer nevd2;
extern doublereal igraphdnrm2_(integer *, doublereal *, integer *);
IGRAPH_F77_SAVE logical getv0;
integer nevm2;
IGRAPH_F77_SAVE logical cnorm;
extern /* Subroutine */ int igraphdcopy_(integer *, doublereal *, integer *,
doublereal *, integer *), igraphdswap_(integer *, doublereal *, integer
*, doublereal *, integer *);
IGRAPH_F77_SAVE integer nconv;
IGRAPH_F77_SAVE logical initv;
IGRAPH_F77_SAVE doublereal rnorm;
real tmvbx = 0.0;
extern /* Subroutine */ int igraphdvout_(integer *, integer *, doublereal *,
integer *, char *, ftnlen), igraphivout_(integer *, integer *, integer *
, integer *, char *, ftnlen), igraphdgetv0_(integer *, char *, integer *
, logical *, integer *, integer *, doublereal *, integer *,
doublereal *, doublereal *, integer *, doublereal *, integer *);
integer msaup2 = 0;
real tsaup2;
extern doublereal igraphdlamch_(char *);
integer nevbef;
extern /* Subroutine */ int igraphsecond_(real *);
integer logfil, ndigit;
extern /* Subroutine */ int igraphdseigt_(doublereal *, integer *, doublereal *,
integer *, doublereal *, doublereal *, doublereal *, integer *);
IGRAPH_F77_SAVE logical update;
extern /* Subroutine */ int igraphdsaitr_(integer *, char *, integer *, integer
*, integer *, integer *, doublereal *, doublereal *, doublereal *,
integer *, doublereal *, integer *, integer *, doublereal *,
integer *), igraphdsgets_(integer *, char *, integer *, integer
*, doublereal *, doublereal *, doublereal *), igraphdsapps_(
integer *, integer *, integer *, doublereal *, doublereal *,
integer *, doublereal *, integer *, doublereal *, doublereal *,
integer *, doublereal *), igraphdsconv_(integer *, doublereal *,
doublereal *, doublereal *, integer *);
IGRAPH_F77_SAVE logical ushift;
char wprime[2];
IGRAPH_F77_SAVE integer msglvl;
integer nptemp;
extern /* Subroutine */ int igraphdsortr_(char *, logical *, integer *,
doublereal *, doublereal *);
IGRAPH_F77_SAVE integer kplusp;
/* %----------------------------------------------------%
| Include files for debugging and timing information |
%----------------------------------------------------%
%------------------%
| Scalar Arguments |
%------------------%
%-----------------%
| Array Arguments |
%-----------------%
%------------%
| Parameters |
%------------%
%---------------%
| Local Scalars |
%---------------%
%----------------------%
| External Subroutines |
%----------------------%
%--------------------%
| External Functions |
%--------------------%
%---------------------%
| Intrinsic Functions |
%---------------------%
%-----------------------%
| Executable Statements |
%-----------------------%
Parameter adjustments */
--workd;
--resid;
--workl;
--bounds;
--ritz;
v_dim1 = *ldv;
v_offset = 1 + v_dim1;
v -= v_offset;
h_dim1 = *ldh;
h_offset = 1 + h_dim1;
h__ -= h_offset;
q_dim1 = *ldq;
q_offset = 1 + q_dim1;
q -= q_offset;
--ipntr;
/* Function Body */
if (*ido == 0) {
/* %-------------------------------%
| Initialize timing statistics |
| & message level for debugging |
%-------------------------------% */
igraphsecond_(&t0);
msglvl = msaup2;
/* %---------------------------------%
| Set machine dependent constant. |
%---------------------------------% */
eps23 = igraphdlamch_("Epsilon-Machine");
eps23 = pow_dd(&eps23, &c_b3);
/* %-------------------------------------%
| nev0 and np0 are integer variables |
| hold the initial values of NEV & NP |
%-------------------------------------% */
nev0 = *nev;
np0 = *np;
/* %-------------------------------------%
| kplusp is the bound on the largest |
| Lanczos factorization built. |
| nconv is the current number of |
| "converged" eigenvlues. |
| iter is the counter on the current |
| iteration step. |
%-------------------------------------% */
kplusp = nev0 + np0;
nconv = 0;
iter = 0;
/* %--------------------------------------------%
| Set flags for computing the first NEV steps |
| of the Lanczos factorization. |
%--------------------------------------------% */
getv0 = TRUE_;
update = FALSE_;
ushift = FALSE_;
cnorm = FALSE_;
if (*info != 0) {
/* %--------------------------------------------%
| User provides the initial residual vector. |
%--------------------------------------------% */
initv = TRUE_;
*info = 0;
} else {
initv = FALSE_;
}
}
/* %---------------------------------------------%
| Get a possibly random starting vector and |
| force it into the range of the operator OP. |
%---------------------------------------------%
L10: */
if (getv0) {
igraphdgetv0_(ido, bmat, &c__1, &initv, n, &c__1, &v[v_offset], ldv, &resid[
1], &rnorm, &ipntr[1], &workd[1], info);
if (*ido != 99) {
goto L9000;
}
if (rnorm == 0.) {
/* %-----------------------------------------%
| The initial vector is zero. Error exit. |
%-----------------------------------------% */
*info = -9;
goto L1200;
}
getv0 = FALSE_;
*ido = 0;
}
/* %------------------------------------------------------------%
| Back from reverse communication: continue with update step |
%------------------------------------------------------------% */
if (update) {
goto L20;
}
/* %-------------------------------------------%
| Back from computing user specified shifts |
%-------------------------------------------% */
if (ushift) {
goto L50;
}
/* %-------------------------------------%
| Back from computing residual norm |
| at the end of the current iteration |
%-------------------------------------% */
if (cnorm) {
goto L100;
}
/* %----------------------------------------------------------%
| Compute the first NEV steps of the Lanczos factorization |
%----------------------------------------------------------% */
igraphdsaitr_(ido, bmat, n, &c__0, &nev0, mode, &resid[1], &rnorm, &v[v_offset],
ldv, &h__[h_offset], ldh, &ipntr[1], &workd[1], info);
/* %---------------------------------------------------%
| ido .ne. 99 implies use of reverse communication |
| to compute operations involving OP and possibly B |
%---------------------------------------------------% */
if (*ido != 99) {
goto L9000;
}
if (*info > 0) {
/* %-----------------------------------------------------%
| dsaitr was unable to build an Lanczos factorization |
| of length NEV0. INFO is returned with the size of |
| the factorization built. Exit main loop. |
%-----------------------------------------------------% */
*np = *info;
*mxiter = iter;
*info = -9999;
goto L1200;
}
/* %--------------------------------------------------------------%
| |
| M A I N LANCZOS I T E R A T I O N L O O P |
| Each iteration implicitly restarts the Lanczos |
| factorization in place. |
| |
%--------------------------------------------------------------% */
L1000:
++iter;
if (msglvl > 0) {
igraphivout_(&logfil, &c__1, &iter, &ndigit, "_saup2: **** Start of major "
"iteration number ****", (ftnlen)49);
}
if (msglvl > 1) {
igraphivout_(&logfil, &c__1, nev, &ndigit, "_saup2: The length of the curr"
"ent Lanczos factorization", (ftnlen)55);
igraphivout_(&logfil, &c__1, np, &ndigit, "_saup2: Extend the Lanczos fact"
"orization by", (ftnlen)43);
}
/* %------------------------------------------------------------%
| Compute NP additional steps of the Lanczos factorization. |
%------------------------------------------------------------% */
*ido = 0;
L20:
update = TRUE_;
igraphdsaitr_(ido, bmat, n, nev, np, mode, &resid[1], &rnorm, &v[v_offset], ldv,
&h__[h_offset], ldh, &ipntr[1], &workd[1], info);
/* %---------------------------------------------------%
| ido .ne. 99 implies use of reverse communication |
| to compute operations involving OP and possibly B |
%---------------------------------------------------% */
if (*ido != 99) {
goto L9000;
}
if (*info > 0) {
/* %-----------------------------------------------------%
| dsaitr was unable to build an Lanczos factorization |
| of length NEV0+NP0. INFO is returned with the size |
| of the factorization built. Exit main loop. |
%-----------------------------------------------------% */
*np = *info;
*mxiter = iter;
*info = -9999;
goto L1200;
}
update = FALSE_;
if (msglvl > 1) {
igraphdvout_(&logfil, &c__1, &rnorm, &ndigit, "_saup2: Current B-norm of r"
"esidual for factorization", (ftnlen)52);
}
/* %--------------------------------------------------------%
| Compute the eigenvalues and corresponding error bounds |
| of the current symmetric tridiagonal matrix. |
%--------------------------------------------------------% */
igraphdseigt_(&rnorm, &kplusp, &h__[h_offset], ldh, &ritz[1], &bounds[1], &
workl[1], &ierr);
if (ierr != 0) {
*info = -8;
goto L1200;
}
/* %----------------------------------------------------%
| Make a copy of eigenvalues and corresponding error |
| bounds obtained from _seigt. |
%----------------------------------------------------% */
igraphdcopy_(&kplusp, &ritz[1], &c__1, &workl[kplusp + 1], &c__1);
igraphdcopy_(&kplusp, &bounds[1], &c__1, &workl[(kplusp << 1) + 1], &c__1);
/* %---------------------------------------------------%
| Select the wanted Ritz values and their bounds |
| to be used in the convergence test. |
| The selection is based on the requested number of |
| eigenvalues instead of the current NEV and NP to |
| prevent possible misconvergence. |
| * Wanted Ritz values := RITZ(NP+1:NEV+NP) |
| * Shifts := RITZ(1:NP) := WORKL(1:NP) |
%---------------------------------------------------% */
*nev = nev0;
*np = np0;
igraphdsgets_(ishift, which, nev, np, &ritz[1], &bounds[1], &workl[1]);
/* %-------------------%
| Convergence test. |
%-------------------% */
igraphdcopy_(nev, &bounds[*np + 1], &c__1, &workl[*np + 1], &c__1);
igraphdsconv_(nev, &ritz[*np + 1], &workl[*np + 1], tol, &nconv);
if (msglvl > 2) {
kp[0] = *nev;
kp[1] = *np;
kp[2] = nconv;
igraphivout_(&logfil, &c__3, kp, &ndigit, "_saup2: NEV, NP, NCONV are", (
ftnlen)26);
igraphdvout_(&logfil, &kplusp, &ritz[1], &ndigit, "_saup2: The eigenvalues"
" of H", (ftnlen)28);
igraphdvout_(&logfil, &kplusp, &bounds[1], &ndigit, "_saup2: Ritz estimate"
"s of the current NCV Ritz values", (ftnlen)53);
}
/* %---------------------------------------------------------%
| Count the number of unwanted Ritz values that have zero |
| Ritz estimates. If any Ritz estimates are equal to zero |
| then a leading block of H of order equal to at least |
| the number of Ritz values with zero Ritz estimates has |
| split off. None of these Ritz values may be removed by |
| shifting. Decrease NP the number of shifts to apply. If |
| no shifts may be applied, then prepare to exit |
%---------------------------------------------------------% */
nptemp = *np;
i__1 = nptemp;
for (j = 1; j <= i__1; ++j) {
if (bounds[j] == 0.) {
--(*np);
++(*nev);
}
/* L30: */
}
if (nconv >= nev0 || iter > *mxiter || *np == 0) {
/* %------------------------------------------------%
| Prepare to exit. Put the converged Ritz values |
| and corresponding bounds in RITZ(1:NCONV) and |
| BOUNDS(1:NCONV) respectively. Then sort. Be |
| careful when NCONV > NP since we don't want to |
| swap overlapping locations. |
%------------------------------------------------% */
if (s_cmp(which, "BE", (ftnlen)2, (ftnlen)2) == 0) {
/* %-----------------------------------------------------%
| Both ends of the spectrum are requested. |
| Sort the eigenvalues into algebraically decreasing |
| order first then swap low end of the spectrum next |
| to high end in appropriate locations. |
| NOTE: when np < floor(nev/2) be careful not to swap |
| overlapping locations. |
%-----------------------------------------------------% */
s_copy(wprime, "SA", (ftnlen)2, (ftnlen)2);
igraphdsortr_(wprime, &c_true, &kplusp, &ritz[1], &bounds[1])
;
nevd2 = *nev / 2;
nevm2 = *nev - nevd2;
if (*nev > 1) {
i__1 = min(nevd2,*np);
/* Computing MAX */
i__2 = kplusp - nevd2 + 1, i__3 = kplusp - *np + 1;
igraphdswap_(&i__1, &ritz[nevm2 + 1], &c__1, &ritz[max(i__2,i__3)],
&c__1);
i__1 = min(nevd2,*np);
/* Computing MAX */
i__2 = kplusp - nevd2 + 1, i__3 = kplusp - *np;
igraphdswap_(&i__1, &bounds[nevm2 + 1], &c__1, &bounds[max(i__2,
i__3) + 1], &c__1);
}
} else {
/* %--------------------------------------------------%
| LM, SM, LA, SA case. |
| Sort the eigenvalues of H into the an order that |
| is opposite to WHICH, and apply the resulting |
| order to BOUNDS. The eigenvalues are sorted so |
| that the wanted part are always within the first |
| NEV locations. |
%--------------------------------------------------% */
if (s_cmp(which, "LM", (ftnlen)2, (ftnlen)2) == 0) {
s_copy(wprime, "SM", (ftnlen)2, (ftnlen)2);
}
if (s_cmp(which, "SM", (ftnlen)2, (ftnlen)2) == 0) {
s_copy(wprime, "LM", (ftnlen)2, (ftnlen)2);
}
if (s_cmp(which, "LA", (ftnlen)2, (ftnlen)2) == 0) {
s_copy(wprime, "SA", (ftnlen)2, (ftnlen)2);
}
if (s_cmp(which, "SA", (ftnlen)2, (ftnlen)2) == 0) {
s_copy(wprime, "LA", (ftnlen)2, (ftnlen)2);
}
igraphdsortr_(wprime, &c_true, &kplusp, &ritz[1], &bounds[1])
;
}
/* %--------------------------------------------------%
| Scale the Ritz estimate of each Ritz value |
| by 1 / max(eps23,magnitude of the Ritz value). |
%--------------------------------------------------% */
i__1 = nev0;
for (j = 1; j <= i__1; ++j) {
/* Computing MAX */
d__2 = eps23, d__3 = (d__1 = ritz[j], abs(d__1));
temp = max(d__2,d__3);
bounds[j] /= temp;
/* L35: */
}
/* %----------------------------------------------------%
| Sort the Ritz values according to the scaled Ritz |
| esitmates. This will push all the converged ones |
| towards the front of ritzr, ritzi, bounds |
| (in the case when NCONV < NEV.) |
%----------------------------------------------------% */
s_copy(wprime, "LA", (ftnlen)2, (ftnlen)2);
igraphdsortr_(wprime, &c_true, &nev0, &bounds[1], &ritz[1]);
/* %----------------------------------------------%
| Scale the Ritz estimate back to its original |
| value. |
%----------------------------------------------% */
i__1 = nev0;
for (j = 1; j <= i__1; ++j) {
/* Computing MAX */
d__2 = eps23, d__3 = (d__1 = ritz[j], abs(d__1));
temp = max(d__2,d__3);
bounds[j] *= temp;
/* L40: */
}
/* %--------------------------------------------------%
| Sort the "converged" Ritz values again so that |
| the "threshold" values and their associated Ritz |
| estimates appear at the appropriate position in |
| ritz and bound. |
%--------------------------------------------------% */
if (s_cmp(which, "BE", (ftnlen)2, (ftnlen)2) == 0) {
/* %------------------------------------------------%
| Sort the "converged" Ritz values in increasing |
| order. The "threshold" values are in the |
| middle. |
%------------------------------------------------% */
s_copy(wprime, "LA", (ftnlen)2, (ftnlen)2);
igraphdsortr_(wprime, &c_true, &nconv, &ritz[1], &bounds[1]);
} else {
/* %----------------------------------------------%
| In LM, SM, LA, SA case, sort the "converged" |
| Ritz values according to WHICH so that the |
| "threshold" value appears at the front of |
| ritz. |
%----------------------------------------------% */
igraphdsortr_(which, &c_true, &nconv, &ritz[1], &bounds[1]);
}
/* %------------------------------------------%
| Use h( 1,1 ) as storage to communicate |
| rnorm to _seupd if needed |
%------------------------------------------% */
h__[h_dim1 + 1] = rnorm;
if (msglvl > 1) {
igraphdvout_(&logfil, &kplusp, &ritz[1], &ndigit, "_saup2: Sorted Ritz"
" values.", (ftnlen)27);
igraphdvout_(&logfil, &kplusp, &bounds[1], &ndigit, "_saup2: Sorted ri"
"tz estimates.", (ftnlen)30);
}
/* %------------------------------------%
| Max iterations have been exceeded. |
%------------------------------------% */
if (iter > *mxiter && nconv < *nev) {
*info = 1;
}
/* %---------------------%
| No shifts to apply. |
%---------------------% */
if (*np == 0 && nconv < nev0) {
*info = 2;
}
*np = nconv;
goto L1100;
} else if (nconv < *nev && *ishift == 1) {
/* %---------------------------------------------------%
| Do not have all the requested eigenvalues yet. |
| To prevent possible stagnation, adjust the number |
| of Ritz values and the shifts. |
%---------------------------------------------------% */
nevbef = *nev;
/* Computing MIN */
i__1 = nconv, i__2 = *np / 2;
*nev += min(i__1,i__2);
if (*nev == 1 && kplusp >= 6) {
*nev = kplusp / 2;
} else if (*nev == 1 && kplusp > 2) {
*nev = 2;
}
*np = kplusp - *nev;
/* %---------------------------------------%
| If the size of NEV was just increased |
| resort the eigenvalues. |
%---------------------------------------% */
if (nevbef < *nev) {
igraphdsgets_(ishift, which, nev, np, &ritz[1], &bounds[1], &workl[1]);
}
}
if (msglvl > 0) {
igraphivout_(&logfil, &c__1, &nconv, &ndigit, "_saup2: no. of \"converge"
"d\" Ritz values at this iter.", (ftnlen)52);
if (msglvl > 1) {
kp[0] = *nev;
kp[1] = *np;
igraphivout_(&logfil, &c__2, kp, &ndigit, "_saup2: NEV and NP are", (
ftnlen)22);
igraphdvout_(&logfil, nev, &ritz[*np + 1], &ndigit, "_saup2: \"wante"
"d\" Ritz values.", (ftnlen)29);
igraphdvout_(&logfil, nev, &bounds[*np + 1], &ndigit, "_saup2: Ritz es"
"timates of the \"wanted\" values ", (ftnlen)46);
}
}
if (*ishift == 0) {
/* %-----------------------------------------------------%
| User specified shifts: reverse communication to |
| compute the shifts. They are returned in the first |
| NP locations of WORKL. |
%-----------------------------------------------------% */
ushift = TRUE_;
*ido = 3;
goto L9000;
}
L50:
/* %------------------------------------%
| Back from reverse communication; |
| User specified shifts are returned |
| in WORKL(1:*NP) |
%------------------------------------% */
ushift = FALSE_;
/* %---------------------------------------------------------%
| Move the NP shifts to the first NP locations of RITZ to |
| free up WORKL. This is for the non-exact shift case; |
| in the exact shift case, dsgets already handles this. |
%---------------------------------------------------------% */
if (*ishift == 0) {
igraphdcopy_(np, &workl[1], &c__1, &ritz[1], &c__1);
}
if (msglvl > 2) {
igraphivout_(&logfil, &c__1, np, &ndigit, "_saup2: The number of shifts to"
" apply ", (ftnlen)38);
igraphdvout_(&logfil, np, &workl[1], &ndigit, "_saup2: shifts selected", (
ftnlen)23);
if (*ishift == 1) {
igraphdvout_(&logfil, np, &bounds[1], &ndigit, "_saup2: corresponding "
"Ritz estimates", (ftnlen)36);
}
}
/* %---------------------------------------------------------%
| Apply the NP0 implicit shifts by QR bulge chasing. |
| Each shift is applied to the entire tridiagonal matrix. |
| The first 2*N locations of WORKD are used as workspace. |
| After dsapps is done, we have a Lanczos |
| factorization of length NEV. |
%---------------------------------------------------------% */
igraphdsapps_(n, nev, np, &ritz[1], &v[v_offset], ldv, &h__[h_offset], ldh, &
resid[1], &q[q_offset], ldq, &workd[1]);
/* %---------------------------------------------%
| Compute the B-norm of the updated residual. |
| Keep B*RESID in WORKD(1:N) to be used in |
| the first step of the next call to dsaitr. |
%---------------------------------------------% */
cnorm = TRUE_;
igraphsecond_(&t2);
if (*(unsigned char *)bmat == 'G') {
++nbx;
igraphdcopy_(n, &resid[1], &c__1, &workd[*n + 1], &c__1);
ipntr[1] = *n + 1;
ipntr[2] = 1;
*ido = 2;
/* %----------------------------------%
| Exit in order to compute B*RESID |
%----------------------------------% */
goto L9000;
} else if (*(unsigned char *)bmat == 'I') {
igraphdcopy_(n, &resid[1], &c__1, &workd[1], &c__1);
}
L100:
/* %----------------------------------%
| Back from reverse communication; |
| WORKD(1:N) := B*RESID |
%----------------------------------% */
if (*(unsigned char *)bmat == 'G') {
igraphsecond_(&t3);
tmvbx += t3 - t2;
}
if (*(unsigned char *)bmat == 'G') {
rnorm = igraphddot_(n, &resid[1], &c__1, &workd[1], &c__1);
rnorm = sqrt((abs(rnorm)));
} else if (*(unsigned char *)bmat == 'I') {
rnorm = igraphdnrm2_(n, &resid[1], &c__1);
}
cnorm = FALSE_;
/* L130: */
if (msglvl > 2) {
igraphdvout_(&logfil, &c__1, &rnorm, &ndigit, "_saup2: B-norm of residual "
"for NEV factorization", (ftnlen)48);
igraphdvout_(&logfil, nev, &h__[(h_dim1 << 1) + 1], &ndigit, "_saup2: main"
" diagonal of compressed H matrix", (ftnlen)44);
i__1 = *nev - 1;
igraphdvout_(&logfil, &i__1, &h__[h_dim1 + 2], &ndigit, "_saup2: subdiagon"
"al of compressed H matrix", (ftnlen)42);
}
goto L1000;
/* %---------------------------------------------------------------%
| |
| E N D O F M A I N I T E R A T I O N L O O P |
| |
%---------------------------------------------------------------% */
L1100:
*mxiter = iter;
*nev = nconv;
L1200:
*ido = 99;
/* %------------%
| Error exit |
%------------% */
igraphsecond_(&t1);
tsaup2 = t1 - t0;
L9000:
return 0;
/* %---------------%
| End of dsaup2 |
%---------------% */
} /* igraphdsaup2_ */
/* ----------------------------------------------------------------------- */
/* Subroutine */ int igraphdseupd_(logical *rvec, char *howmny, logical *
select, doublereal *d__, doublereal *z__, integer *ldz, doublereal *
sigma, char *bmat, integer *n, char *which, integer *nev, doublereal *
tol, doublereal *resid, integer *ncv, doublereal *v, integer *ldv,
integer *iparam, integer *ipntr, doublereal *workd, doublereal *workl,
integer *lworkl, integer *info)
{
/* System generated locals */
integer v_dim1, v_offset, z_dim1, z_offset, i__1;
doublereal d__1, d__2, d__3;
/* Builtin functions */
integer igraphs_cmp(char *, char *, ftnlen, ftnlen);
/* Subroutine */ int igraphs_copy(char *, char *, ftnlen, ftnlen);
double igraphpow_dd(doublereal *, doublereal *);
/* Local variables */
static integer j, k, ih, jj, iq, np, iw;
extern /* Subroutine */ int igraphdger_(integer *, integer *, doublereal *
, doublereal *, integer *, doublereal *, integer *, doublereal *,
integer *);
static integer ibd, ihb, ihd, ldh;
extern doublereal igraphdnrm2_(integer *, doublereal *, integer *);
static integer ldq, irz;
extern /* Subroutine */ int igraphdscal_(integer *, doublereal *,
doublereal *, integer *), igraphdcopy_(integer *, doublereal *,
integer *, doublereal *, integer *), igraphdvout_(integer *,
integer *, doublereal *, integer *, char *), igraphivout_(
integer *, integer *, integer *, integer *, char *),
igraphdgeqr2_(integer *, integer *, doublereal *, integer *,
doublereal *, doublereal *, integer *);
static integer mode;
static doublereal eps23;
extern /* Subroutine */ int igraphdorm2r_(char *, char *, integer *,
integer *, integer *, doublereal *, integer *, doublereal *,
doublereal *, integer *, doublereal *, integer *);
static integer ierr;
static doublereal temp;
static integer next;
static char type__[6];
extern doublereal igraphdlamch_(char *);
static integer ritz;
extern /* Subroutine */ int igraphdlacpy_(char *, integer *, integer *,
doublereal *, integer *, doublereal *, integer *),
igraphdsgets_(integer *, char *, integer *, integer *, doublereal
*, doublereal *, doublereal *);
static doublereal temp1;
extern /* Subroutine */ int igraphdsteqr_(char *, integer *, doublereal *,
doublereal *, doublereal *, integer *, doublereal *, integer *), igraphdsesrt_(char *, logical *, integer *, doublereal *,
integer *, doublereal *, integer *), igraphdsortr_(char *
, logical *, integer *, doublereal *, doublereal *);
static logical reord;
static integer nconv;
static doublereal rnorm, bnorm2;
static integer bounds, msglvl, ishift, numcnv, leftptr, rghtptr;
/* %----------------------------------------------------% */
/* | Include files for debugging and timing information | */
/* %----------------------------------------------------% */
/* \SCCS Information: @(#) */
/* FILE: debug.h SID: 2.3 DATE OF SID: 11/16/95 RELEASE: 2 */
/* %---------------------------------% */
/* | See debug.doc for documentation | */
/* %---------------------------------% */
/* %------------------% */
/* | Scalar Arguments | */
/* %------------------% */
/* %--------------------------------% */
/* | See stat.doc for documentation | */
/* %--------------------------------% */
/* \SCCS Information: @(#) */
/* FILE: stat.h SID: 2.2 DATE OF SID: 11/16/95 RELEASE: 2 */
/* %-----------------% */
/* | Array Arguments | */
/* %-----------------% */
/* %------------% */
/* | Parameters | */
/* %------------% */
/* %---------------% */
/* | Local Scalars | */
/* %---------------% */
/* %----------------------% */
/* | External Subroutines | */
/* %----------------------% */
/* %--------------------% */
/* | External Functions | */
/* %--------------------% */
/* %---------------------% */
/* | Intrinsic Functions | */
/* %---------------------% */
/* %-----------------------% */
/* | Executable Statements | */
/* %-----------------------% */
/* %------------------------% */
/* | Set default parameters | */
/* %------------------------% */
/* Parameter adjustments */
--workd;
--resid;
z_dim1 = *ldz;
z_offset = 1 + z_dim1;
z__ -= z_offset;
--d__;
--select;
v_dim1 = *ldv;
v_offset = 1 + v_dim1;
v -= v_offset;
--iparam;
--ipntr;
--workl;
/* Function Body */
msglvl = debug_1.mseupd;
mode = iparam[7];
nconv = iparam[5];
*info = 0;
/* %--------------% */
/* | Quick return | */
/* %--------------% */
if (nconv == 0) {
goto L9000;
}
ierr = 0;
if (nconv <= 0) {
ierr = -14;
}
if (*n <= 0) {
ierr = -1;
}
if (*nev <= 0) {
ierr = -2;
}
if (*ncv <= *nev || *ncv > *n) {
ierr = -3;
}
if (igraphs_cmp(which, "LM", (ftnlen)2, (ftnlen)2) != 0 && igraphs_cmp(which, "SM", (
ftnlen)2, (ftnlen)2) != 0 && igraphs_cmp(which, "LA", (ftnlen)2, (
ftnlen)2) != 0 && igraphs_cmp(which, "SA", (ftnlen)2, (ftnlen)2) != 0 &&
igraphs_cmp(which, "BE", (ftnlen)2, (ftnlen)2) != 0) {
ierr = -5;
}
if (*(unsigned char *)bmat != 'I' && *(unsigned char *)bmat != 'G') {
ierr = -6;
}
if (*(unsigned char *)howmny != 'A' && *(unsigned char *)howmny != 'P' &&
*(unsigned char *)howmny != 'S' && *rvec) {
ierr = -15;
}
if (*rvec && *(unsigned char *)howmny == 'S') {
ierr = -16;
}
/* Computing 2nd power */
i__1 = *ncv;
if (*rvec && *lworkl < i__1 * i__1 + (*ncv << 3)) {
ierr = -7;
}
if (mode == 1 || mode == 2) {
igraphs_copy(type__, "REGULR", (ftnlen)6, (ftnlen)6);
} else if (mode == 3) {
igraphs_copy(type__, "SHIFTI", (ftnlen)6, (ftnlen)6);
} else if (mode == 4) {
igraphs_copy(type__, "BUCKLE", (ftnlen)6, (ftnlen)6);
} else if (mode == 5) {
igraphs_copy(type__, "CAYLEY", (ftnlen)6, (ftnlen)6);
} else {
ierr = -10;
}
if (mode == 1 && *(unsigned char *)bmat == 'G') {
ierr = -11;
}
if (*nev == 1 && igraphs_cmp(which, "BE", (ftnlen)2, (ftnlen)2) == 0) {
ierr = -12;
}
/* %------------% */
/* | Error Exit | */
/* %------------% */
if (ierr != 0) {
*info = ierr;
goto L9000;
}
/* %-------------------------------------------------------% */
/* | Pointer into WORKL for address of H, RITZ, BOUNDS, Q | */
/* | etc... and the remaining workspace. | */
/* | Also update pointer to be used on output. | */
/* | Memory is laid out as follows: | */
/* | workl(1:2*ncv) := generated tridiagonal matrix H | */
/* | The subdiagonal is stored in workl(2:ncv). | */
/* | The dead spot is workl(1) but upon exiting | */
/* | dsaupd stores the B-norm of the last residual | */
/* | vector in workl(1). We use this !!! | */
/* | workl(2*ncv+1:2*ncv+ncv) := ritz values | */
/* | The wanted values are in the first NCONV spots. | */
/* | workl(3*ncv+1:3*ncv+ncv) := computed Ritz estimates | */
/* | The wanted values are in the first NCONV spots. | */
/* | NOTE: workl(1:4*ncv) is set by dsaupd and is not | */
/* | modified by dseupd . | */
/* %-------------------------------------------------------% */
/* %-------------------------------------------------------% */
/* | The following is used and set by dseupd . | */
/* | workl(4*ncv+1:4*ncv+ncv) := used as workspace during | */
/* | computation of the eigenvectors of H. Stores | */
/* | the diagonal of H. Upon EXIT contains the NCV | */
/* | Ritz values of the original system. The first | */
/* | NCONV spots have the wanted values. If MODE = | */
/* | 1 or 2 then will equal workl(2*ncv+1:3*ncv). | */
/* | workl(5*ncv+1:5*ncv+ncv) := used as workspace during | */
/* | computation of the eigenvectors of H. Stores | */
/* | the subdiagonal of H. Upon EXIT contains the | */
/* | NCV corresponding Ritz estimates of the | */
/* | original system. The first NCONV spots have the | */
/* | wanted values. If MODE = 1,2 then will equal | */
/* | workl(3*ncv+1:4*ncv). | */
/* | workl(6*ncv+1:6*ncv+ncv*ncv) := orthogonal Q that is | */
/* | the eigenvector matrix for H as returned by | */
/* | dsteqr . Not referenced if RVEC = .False. | */
/* | Ordering follows that of workl(4*ncv+1:5*ncv) | */
/* | workl(6*ncv+ncv*ncv+1:6*ncv+ncv*ncv+2*ncv) := | */
/* | Workspace. Needed by dsteqr and by dseupd . | */
/* | GRAND total of NCV*(NCV+8) locations. | */
/* %-------------------------------------------------------% */
ih = ipntr[5];
ritz = ipntr[6];
bounds = ipntr[7];
ldh = *ncv;
ldq = *ncv;
ihd = bounds + ldh;
ihb = ihd + ldh;
iq = ihb + ldh;
iw = iq + ldh * *ncv;
next = iw + (*ncv << 1);
ipntr[4] = next;
ipntr[8] = ihd;
ipntr[9] = ihb;
ipntr[10] = iq;
/* %----------------------------------------% */
/* | irz points to the Ritz values computed | */
/* | by _seigt before exiting _saup2. | */
/* | ibd points to the Ritz estimates | */
/* | computed by _seigt before exiting | */
/* | _saup2. | */
/* %----------------------------------------% */
irz = ipntr[11] + *ncv;
ibd = irz + *ncv;
/* %---------------------------------% */
/* | Set machine dependent constant. | */
/* %---------------------------------% */
eps23 = igraphdlamch_("Epsilon-Machine");
eps23 = igraphpow_dd(&eps23, &c_b21);
/* %---------------------------------------% */
/* | RNORM is B-norm of the RESID(1:N). | */
/* | BNORM2 is the 2 norm of B*RESID(1:N). | */
/* | Upon exit of dsaupd WORKD(1:N) has | */
/* | B*RESID(1:N). | */
/* %---------------------------------------% */
rnorm = workl[ih];
if (*(unsigned char *)bmat == 'I') {
bnorm2 = rnorm;
} else if (*(unsigned char *)bmat == 'G') {
bnorm2 = igraphdnrm2_(n, &workd[1], &c__1);
}
if (msglvl > 2) {
igraphdvout_(&debug_1.logfil, ncv, &workl[irz], &debug_1.ndigit,
"_seupd: Ritz values passed in from _SAUPD.");
igraphdvout_(&debug_1.logfil, ncv, &workl[ibd], &debug_1.ndigit,
"_seupd: Ritz estimates passed in from _SAUPD.");
}
if (*rvec) {
reord = FALSE_;
/* %---------------------------------------------------% */
/* | Use the temporary bounds array to store indices | */
/* | These will be used to mark the select array later | */
/* %---------------------------------------------------% */
i__1 = *ncv;
for (j = 1; j <= i__1; ++j) {
workl[bounds + j - 1] = (doublereal) j;
select[j] = FALSE_;
/* L10: */
}
/* %-------------------------------------% */
/* | Select the wanted Ritz values. | */
/* | Sort the Ritz values so that the | */
/* | wanted ones appear at the tailing | */
/* | NEV positions of workl(irr) and | */
/* | workl(iri). Move the corresponding | */
/* | error estimates in workl(bound) | */
/* | accordingly. | */
/* %-------------------------------------% */
np = *ncv - *nev;
ishift = 0;
igraphdsgets_(&ishift, which, nev, &np, &workl[irz], &workl[bounds], &
workl[1]);
if (msglvl > 2) {
igraphdvout_(&debug_1.logfil, ncv, &workl[irz], &debug_1.ndigit,
"_seupd: Ritz values after calling _SGETS.");
igraphdvout_(&debug_1.logfil, ncv, &workl[bounds], &
debug_1.ndigit, "_seupd: Ritz value indices after callin"
"g _SGETS.");
}
/* %-----------------------------------------------------% */
/* | Record indices of the converged wanted Ritz values | */
/* | Mark the select array for possible reordering | */
/* %-----------------------------------------------------% */
numcnv = 0;
i__1 = *ncv;
for (j = 1; j <= i__1; ++j) {
/* Computing MAX */
d__2 = eps23, d__3 = (d__1 = workl[irz + *ncv - j], abs(d__1));
temp1 = max(d__2,d__3);
jj = (integer) workl[bounds + *ncv - j];
if (numcnv < nconv && workl[ibd + jj - 1] <= *tol * temp1) {
select[jj] = TRUE_;
++numcnv;
if (jj > *nev) {
reord = TRUE_;
}
}
/* L11: */
}
/* %-----------------------------------------------------------% */
/* | Check the count (numcnv) of converged Ritz values with | */
/* | the number (nconv) reported by _saupd. If these two | */
/* | are different then there has probably been an error | */
/* | caused by incorrect passing of the _saupd data. | */
/* %-----------------------------------------------------------% */
if (msglvl > 2) {
igraphivout_(&debug_1.logfil, &c__1, &numcnv, &debug_1.ndigit,
"_seupd: Number of specified eigenvalues");
igraphivout_(&debug_1.logfil, &c__1, &nconv, &debug_1.ndigit,
"_seupd: Number of \"converged\" eigenvalues")
;
}
if (numcnv != nconv) {
*info = -17;
goto L9000;
}
/* %-----------------------------------------------------------% */
/* | Call LAPACK routine _steqr to compute the eigenvalues and | */
/* | eigenvectors of the final symmetric tridiagonal matrix H. | */
/* | Initialize the eigenvector matrix Q to the identity. | */
/* %-----------------------------------------------------------% */
i__1 = *ncv - 1;
igraphdcopy_(&i__1, &workl[ih + 1], &c__1, &workl[ihb], &c__1);
igraphdcopy_(ncv, &workl[ih + ldh], &c__1, &workl[ihd], &c__1);
igraphdsteqr_("Identity", ncv, &workl[ihd], &workl[ihb], &workl[iq], &
ldq, &workl[iw], &ierr);
if (ierr != 0) {
*info = -8;
goto L9000;
}
if (msglvl > 1) {
igraphdcopy_(ncv, &workl[iq + *ncv - 1], &ldq, &workl[iw], &c__1);
igraphdvout_(&debug_1.logfil, ncv, &workl[ihd], &debug_1.ndigit,
"_seupd: NCV Ritz values of the final H matrix");
igraphdvout_(&debug_1.logfil, ncv, &workl[iw], &debug_1.ndigit,
"_seupd: last row of the eigenvector matrix for H");
}
if (reord) {
/* %---------------------------------------------% */
/* | Reordered the eigenvalues and eigenvectors | */
/* | computed by _steqr so that the "converged" | */
/* | eigenvalues appear in the first NCONV | */
/* | positions of workl(ihd), and the associated | */
/* | eigenvectors appear in the first NCONV | */
/* | columns. | */
/* %---------------------------------------------% */
leftptr = 1;
rghtptr = *ncv;
if (*ncv == 1) {
goto L30;
}
L20:
if (select[leftptr]) {
/* %-------------------------------------------% */
/* | Search, from the left, for the first Ritz | */
/* | value that has not converged. | */
/* %-------------------------------------------% */
++leftptr;
} else if (! select[rghtptr]) {
/* %----------------------------------------------% */
/* | Search, from the right, the first Ritz value | */
/* | that has converged. | */
/* %----------------------------------------------% */
--rghtptr;
} else {
/* %----------------------------------------------% */
/* | Swap the Ritz value on the left that has not | */
/* | converged with the Ritz value on the right | */
/* | that has converged. Swap the associated | */
/* | eigenvector of the tridiagonal matrix H as | */
/* | well. | */
/* %----------------------------------------------% */
temp = workl[ihd + leftptr - 1];
workl[ihd + leftptr - 1] = workl[ihd + rghtptr - 1];
workl[ihd + rghtptr - 1] = temp;
igraphdcopy_(ncv, &workl[iq + *ncv * (leftptr - 1)], &c__1, &
workl[iw], &c__1);
igraphdcopy_(ncv, &workl[iq + *ncv * (rghtptr - 1)], &c__1, &
workl[iq + *ncv * (leftptr - 1)], &c__1);
igraphdcopy_(ncv, &workl[iw], &c__1, &workl[iq + *ncv * (
rghtptr - 1)], &c__1);
++leftptr;
--rghtptr;
}
if (leftptr < rghtptr) {
goto L20;
}
L30:
;
}
if (msglvl > 2) {
igraphdvout_(&debug_1.logfil, ncv, &workl[ihd], &debug_1.ndigit,
"_seupd: The eigenvalues of H--reordered");
}
/* %----------------------------------------% */
/* | Load the converged Ritz values into D. | */
/* %----------------------------------------% */
igraphdcopy_(&nconv, &workl[ihd], &c__1, &d__[1], &c__1);
} else {
/* %-----------------------------------------------------% */
/* | Ritz vectors not required. Load Ritz values into D. | */
/* %-----------------------------------------------------% */
igraphdcopy_(&nconv, &workl[ritz], &c__1, &d__[1], &c__1);
igraphdcopy_(ncv, &workl[ritz], &c__1, &workl[ihd], &c__1);
}
/* %------------------------------------------------------------------% */
/* | Transform the Ritz values and possibly vectors and corresponding | */
/* | Ritz estimates of OP to those of A*x=lambda*B*x. The Ritz values | */
/* | (and corresponding data) are returned in ascending order. | */
/* %------------------------------------------------------------------% */
if (igraphs_cmp(type__, "REGULR", (ftnlen)6, (ftnlen)6) == 0) {
/* %---------------------------------------------------------% */
/* | Ascending sort of wanted Ritz values, vectors and error | */
/* | bounds. Not necessary if only Ritz values are desired. | */
/* %---------------------------------------------------------% */
if (*rvec) {
igraphdsesrt_("LA", rvec, &nconv, &d__[1], ncv, &workl[iq], &ldq);
} else {
igraphdcopy_(ncv, &workl[bounds], &c__1, &workl[ihb], &c__1);
}
} else {
/* %-------------------------------------------------------------% */
/* | * Make a copy of all the Ritz values. | */
/* | * Transform the Ritz values back to the original system. | */
/* | For TYPE = 'SHIFTI' the transformation is | */
/* | lambda = 1/theta + sigma | */
/* | For TYPE = 'BUCKLE' the transformation is | */
/* | lambda = sigma * theta / ( theta - 1 ) | */
/* | For TYPE = 'CAYLEY' the transformation is | */
/* | lambda = sigma * (theta + 1) / (theta - 1 ) | */
/* | where the theta are the Ritz values returned by dsaupd . | */
/* | NOTES: | */
/* | *The Ritz vectors are not affected by the transformation. | */
/* | They are only reordered. | */
/* %-------------------------------------------------------------% */
igraphdcopy_(ncv, &workl[ihd], &c__1, &workl[iw], &c__1);
if (igraphs_cmp(type__, "SHIFTI", (ftnlen)6, (ftnlen)6) == 0) {
i__1 = *ncv;
for (k = 1; k <= i__1; ++k) {
workl[ihd + k - 1] = 1. / workl[ihd + k - 1] + *sigma;
/* L40: */
}
} else if (igraphs_cmp(type__, "BUCKLE", (ftnlen)6, (ftnlen)6) == 0) {
i__1 = *ncv;
for (k = 1; k <= i__1; ++k) {
workl[ihd + k - 1] = *sigma * workl[ihd + k - 1] / (workl[ihd
+ k - 1] - 1.);
/* L50: */
}
} else if (igraphs_cmp(type__, "CAYLEY", (ftnlen)6, (ftnlen)6) == 0) {
i__1 = *ncv;
for (k = 1; k <= i__1; ++k) {
workl[ihd + k - 1] = *sigma * (workl[ihd + k - 1] + 1.) / (
workl[ihd + k - 1] - 1.);
/* L60: */
}
}
/* %-------------------------------------------------------------% */
/* | * Store the wanted NCONV lambda values into D. | */
/* | * Sort the NCONV wanted lambda in WORKL(IHD:IHD+NCONV-1) | */
/* | into ascending order and apply sort to the NCONV theta | */
/* | values in the transformed system. We will need this to | */
/* | compute Ritz estimates in the original system. | */
/* | * Finally sort the lambda`s into ascending order and apply | */
/* | to Ritz vectors if wanted. Else just sort lambda`s into | */
/* | ascending order. | */
/* | NOTES: | */
/* | *workl(iw:iw+ncv-1) contain the theta ordered so that they | */
/* | match the ordering of the lambda. We`ll use them again for | */
/* | Ritz vector purification. | */
/* %-------------------------------------------------------------% */
igraphdcopy_(&nconv, &workl[ihd], &c__1, &d__[1], &c__1);
igraphdsortr_("LA", &c_true, &nconv, &workl[ihd], &workl[iw]);
if (*rvec) {
igraphdsesrt_("LA", rvec, &nconv, &d__[1], ncv, &workl[iq], &ldq);
} else {
igraphdcopy_(ncv, &workl[bounds], &c__1, &workl[ihb], &c__1);
d__1 = bnorm2 / rnorm;
igraphdscal_(ncv, &d__1, &workl[ihb], &c__1);
igraphdsortr_("LA", &c_true, &nconv, &d__[1], &workl[ihb]);
}
}
/* %------------------------------------------------% */
/* | Compute the Ritz vectors. Transform the wanted | */
/* | eigenvectors of the symmetric tridiagonal H by | */
/* | the Lanczos basis matrix V. | */
/* %------------------------------------------------% */
if (*rvec && *(unsigned char *)howmny == 'A') {
/* %----------------------------------------------------------% */
/* | Compute the QR factorization of the matrix representing | */
/* | the wanted invariant subspace located in the first NCONV | */
/* | columns of workl(iq,ldq). | */
/* %----------------------------------------------------------% */
igraphdgeqr2_(ncv, &nconv, &workl[iq], &ldq, &workl[iw + *ncv], &
workl[ihb], &ierr);
/* %--------------------------------------------------------% */
/* | * Postmultiply V by Q. | */
/* | * Copy the first NCONV columns of VQ into Z. | */
/* | The N by NCONV matrix Z is now a matrix representation | */
/* | of the approximate invariant subspace associated with | */
/* | the Ritz values in workl(ihd). | */
/* %--------------------------------------------------------% */
igraphdorm2r_("Right", "Notranspose", n, ncv, &nconv, &workl[iq], &
ldq, &workl[iw + *ncv], &v[v_offset], ldv, &workd[*n + 1], &
ierr);
igraphdlacpy_("All", n, &nconv, &v[v_offset], ldv, &z__[z_offset],
ldz);
/* %-----------------------------------------------------% */
/* | In order to compute the Ritz estimates for the Ritz | */
/* | values in both systems, need the last row of the | */
/* | eigenvector matrix. Remember, it`s in factored form | */
/* %-----------------------------------------------------% */
i__1 = *ncv - 1;
for (j = 1; j <= i__1; ++j) {
workl[ihb + j - 1] = 0.;
/* L65: */
}
workl[ihb + *ncv - 1] = 1.;
igraphdorm2r_("Left", "Transpose", ncv, &c__1, &nconv, &workl[iq], &
ldq, &workl[iw + *ncv], &workl[ihb], ncv, &temp, &ierr);
} else if (*rvec && *(unsigned char *)howmny == 'S') {
/* Not yet implemented. See remark 2 above. */
}
if (igraphs_cmp(type__, "REGULR", (ftnlen)6, (ftnlen)6) == 0 && *rvec) {
i__1 = *ncv;
for (j = 1; j <= i__1; ++j) {
workl[ihb + j - 1] = rnorm * (d__1 = workl[ihb + j - 1], abs(d__1)
);
/* L70: */
}
} else if (igraphs_cmp(type__, "REGULR", (ftnlen)6, (ftnlen)6) != 0 && *rvec) {
/* %-------------------------------------------------% */
/* | * Determine Ritz estimates of the theta. | */
/* | If RVEC = .true. then compute Ritz estimates | */
/* | of the theta. | */
/* | If RVEC = .false. then copy Ritz estimates | */
/* | as computed by dsaupd . | */
/* | * Determine Ritz estimates of the lambda. | */
/* %-------------------------------------------------% */
igraphdscal_(ncv, &bnorm2, &workl[ihb], &c__1);
if (igraphs_cmp(type__, "SHIFTI", (ftnlen)6, (ftnlen)6) == 0) {
i__1 = *ncv;
for (k = 1; k <= i__1; ++k) {
/* Computing 2nd power */
d__2 = workl[iw + k - 1];
workl[ihb + k - 1] = (d__1 = workl[ihb + k - 1], abs(d__1)) /
(d__2 * d__2);
/* L80: */
}
} else if (igraphs_cmp(type__, "BUCKLE", (ftnlen)6, (ftnlen)6) == 0) {
i__1 = *ncv;
for (k = 1; k <= i__1; ++k) {
/* Computing 2nd power */
d__2 = workl[iw + k - 1] - 1.;
workl[ihb + k - 1] = *sigma * (d__1 = workl[ihb + k - 1], abs(
d__1)) / (d__2 * d__2);
/* L90: */
}
} else if (igraphs_cmp(type__, "CAYLEY", (ftnlen)6, (ftnlen)6) == 0) {
i__1 = *ncv;
for (k = 1; k <= i__1; ++k) {
workl[ihb + k - 1] = (d__1 = workl[ihb + k - 1] / workl[iw +
k - 1] * (workl[iw + k - 1] - 1.), abs(d__1));
/* L100: */
}
}
}
if (igraphs_cmp(type__, "REGULR", (ftnlen)6, (ftnlen)6) != 0 && msglvl > 1) {
igraphdvout_(&debug_1.logfil, &nconv, &d__[1], &debug_1.ndigit, "_se"
"upd: Untransformed converged Ritz values");
igraphdvout_(&debug_1.logfil, &nconv, &workl[ihb], &debug_1.ndigit,
"_seupd: Ritz estimates of the untransformed Ritz values");
} else if (msglvl > 1) {
igraphdvout_(&debug_1.logfil, &nconv, &d__[1], &debug_1.ndigit, "_se"
"upd: Converged Ritz values");
igraphdvout_(&debug_1.logfil, &nconv, &workl[ihb], &debug_1.ndigit,
"_seupd: Associated Ritz estimates");
}
/* %-------------------------------------------------% */
/* | Ritz vector purification step. Formally perform | */
/* | one of inverse subspace iteration. Only used | */
/* | for MODE = 3,4,5. See reference 7 | */
/* %-------------------------------------------------% */
if (*rvec && (igraphs_cmp(type__, "SHIFTI", (ftnlen)6, (ftnlen)6) == 0 || igraphs_cmp(
type__, "CAYLEY", (ftnlen)6, (ftnlen)6) == 0)) {
i__1 = nconv - 1;
for (k = 0; k <= i__1; ++k) {
workl[iw + k] = workl[iq + k * ldq + *ncv - 1] / workl[iw + k];
/* L110: */
}
} else if (*rvec && igraphs_cmp(type__, "BUCKLE", (ftnlen)6, (ftnlen)6) == 0) {
i__1 = nconv - 1;
for (k = 0; k <= i__1; ++k) {
workl[iw + k] = workl[iq + k * ldq + *ncv - 1] / (workl[iw + k] -
1.);
/* L120: */
}
}
if (igraphs_cmp(type__, "REGULR", (ftnlen)6, (ftnlen)6) != 0) {
igraphdger_(n, &nconv, &c_b110, &resid[1], &c__1, &workl[iw], &c__1, &
z__[z_offset], ldz);
}
L9000:
return 0;
/* %---------------% */
/* | End of dseupd | */
/* %---------------% */
} /* igraphdseupd_ */