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_ */