PetscErrorCode EPSSolve_LAPACK(EPS eps)
{
PetscErrorCode ierr;
PetscInt n=eps->n,i,low,high;
PetscScalar *array,*pX;
Vec v;
PetscFunctionBegin;
ierr = DSSolve(eps->ds,eps->eigr,eps->eigi);CHKERRQ(ierr);
ierr = DSSort(eps->ds,eps->eigr,eps->eigi,NULL,NULL,NULL);CHKERRQ(ierr);
/* right eigenvectors */
ierr = DSVectors(eps->ds,DS_MAT_X,NULL,NULL);CHKERRQ(ierr);
ierr = DSGetArray(eps->ds,DS_MAT_X,&pX);CHKERRQ(ierr);
for (i=0;i<eps->ncv;i++) {
ierr = BVGetColumn(eps->V,i,&v);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(v,&low,&high);CHKERRQ(ierr);
ierr = VecGetArray(v,&array);CHKERRQ(ierr);
ierr = PetscMemcpy(array,pX+i*n+low,(high-low)*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
ierr = BVRestoreColumn(eps->V,i,&v);CHKERRQ(ierr);
}
ierr = DSRestoreArray(eps->ds,DS_MAT_X,&pX);CHKERRQ(ierr);
eps->nconv = eps->ncv;
eps->its = 1;
eps->reason = EPS_CONVERGED_TOL;
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
PetscErrorCode ierr;
DS ds;
SlepcSC sc;
PetscScalar *A,*B,*wr,*wi;
PetscReal re,im;
PetscInt i,j,n=10,ld;
PetscViewer viewer;
PetscBool verbose;
SlepcInitialize(&argc,&argv,(char*)0,help);
ierr = PetscOptionsGetInt(NULL,"-n",&n,NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Solve a Dense System of type GNHEP - dimension %D.\n",n);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,"-verbose",&verbose);CHKERRQ(ierr);
/* Create DS object */
ierr = DSCreate(PETSC_COMM_WORLD,&ds);CHKERRQ(ierr);
ierr = DSSetType(ds,DSGNHEP);CHKERRQ(ierr);
ierr = DSSetFromOptions(ds);CHKERRQ(ierr);
ld = n+2; /* test leading dimension larger than n */
ierr = DSAllocate(ds,ld);CHKERRQ(ierr);
ierr = DSSetDimensions(ds,n,0,0,0);CHKERRQ(ierr);
/* Set up viewer */
ierr = PetscViewerASCIIGetStdout(PETSC_COMM_WORLD,&viewer);CHKERRQ(ierr);
ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_INFO_DETAIL);CHKERRQ(ierr);
ierr = DSView(ds,viewer);CHKERRQ(ierr);
ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
if (verbose) {
ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
}
/* Fill A with Grcar matrix */
ierr = DSGetArray(ds,DS_MAT_A,&A);CHKERRQ(ierr);
ierr = PetscMemzero(A,sizeof(PetscScalar)*ld*n);CHKERRQ(ierr);
for (i=1;i<n;i++) A[i+(i-1)*ld]=-1.0;
for (j=0;j<4;j++) {
for (i=0;i<n-j;i++) A[i+(i+j)*ld]=1.0;
}
ierr = DSRestoreArray(ds,DS_MAT_A,&A);CHKERRQ(ierr);
/* Fill B with an identity matrix */
ierr = DSGetArray(ds,DS_MAT_B,&B);CHKERRQ(ierr);
ierr = PetscMemzero(B,sizeof(PetscScalar)*ld*n);CHKERRQ(ierr);
for (i=0;i<n;i++) B[i+i*ld]=1.0;
ierr = DSRestoreArray(ds,DS_MAT_B,&B);CHKERRQ(ierr);
if (verbose) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"Initial - - - - - - - - -\n");CHKERRQ(ierr);
ierr = DSView(ds,viewer);CHKERRQ(ierr);
}
/* Solve */
ierr = PetscMalloc2(n,&wr,n,&wi);CHKERRQ(ierr);
ierr = DSGetSlepcSC(ds,&sc);CHKERRQ(ierr);
sc->comparison = SlepcCompareLargestMagnitude;
sc->comparisonctx = NULL;
sc->map = NULL;
sc->mapobj = NULL;
ierr = DSSolve(ds,wr,wi);CHKERRQ(ierr);
ierr = DSSort(ds,wr,wi,NULL,NULL,NULL);CHKERRQ(ierr);
if (verbose) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"After solve - - - - - - - - -\n");CHKERRQ(ierr);
ierr = DSView(ds,viewer);CHKERRQ(ierr);
}
/* Print eigenvalues */
ierr = PetscPrintf(PETSC_COMM_WORLD,"Computed eigenvalues =\n",n);CHKERRQ(ierr);
for (i=0;i<n;i++) {
#if defined(PETSC_USE_COMPLEX)
re = PetscRealPart(wr[i]);
im = PetscImaginaryPart(wr[i]);
#else
re = wr[i];
im = wi[i];
#endif
if (PetscAbs(im)<1e-10) {
ierr = PetscViewerASCIIPrintf(viewer," %.5f\n",(double)re);CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIIPrintf(viewer," %.5f%+.5fi\n",(double)re,(double)im);CHKERRQ(ierr);
}
}
ierr = PetscFree2(wr,wi);CHKERRQ(ierr);
ierr = DSDestroy(&ds);CHKERRQ(ierr);
ierr = SlepcFinalize();
return 0;
}
int main(int argc,char **argv)
{
PetscErrorCode ierr;
DS ds;
FN f1,f2,f3,funs[3];
PetscScalar *Id,*A,*B,*wr,*wi,coeffs[2];
PetscReal tau=0.001,h,a=20,xi,re,im;
PetscInt i,n=10,ld,nev;
PetscViewer viewer;
PetscBool verbose;
SlepcInitialize(&argc,&argv,(char*)0,help);
ierr = PetscOptionsGetInt(NULL,"-n",&n,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetReal(NULL,"-tau",&tau,NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Solve a Dense System of type NEP - dimension %D, tau=%g.\n",n,(double)tau);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,"-verbose",&verbose);CHKERRQ(ierr);
/* Create DS object */
ierr = DSCreate(PETSC_COMM_WORLD,&ds);CHKERRQ(ierr);
ierr = DSSetType(ds,DSNEP);CHKERRQ(ierr);
ierr = DSSetFromOptions(ds);CHKERRQ(ierr);
/* Set functions (prior to DSAllocate) */
ierr = FNCreate(PETSC_COMM_WORLD,&f1);CHKERRQ(ierr);
ierr = FNSetType(f1,FNRATIONAL);CHKERRQ(ierr);
coeffs[0] = -1.0; coeffs[1] = 0.0;
ierr = FNSetParameters(f1,2,coeffs,0,NULL);CHKERRQ(ierr);
ierr = FNCreate(PETSC_COMM_WORLD,&f2);CHKERRQ(ierr);
ierr = FNSetType(f2,FNRATIONAL);CHKERRQ(ierr);
coeffs[0] = 1.0;
ierr = FNSetParameters(f2,1,coeffs,0,NULL);CHKERRQ(ierr);
ierr = FNCreate(PETSC_COMM_WORLD,&f3);CHKERRQ(ierr);
ierr = FNSetType(f3,FNEXP);CHKERRQ(ierr);
coeffs[0] = -tau;
ierr = FNSetParameters(f3,1,coeffs,0,NULL);CHKERRQ(ierr);
funs[0] = f1;
funs[1] = f2;
funs[2] = f3;
ierr = DSSetFN(ds,3,funs);CHKERRQ(ierr);
/* Set dimensions */
ld = n+2; /* test leading dimension larger than n */
ierr = DSAllocate(ds,ld);CHKERRQ(ierr);
ierr = DSSetDimensions(ds,n,0,0,0);CHKERRQ(ierr);
/* Set up viewer */
ierr = PetscViewerASCIIGetStdout(PETSC_COMM_WORLD,&viewer);CHKERRQ(ierr);
ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_INFO_DETAIL);CHKERRQ(ierr);
ierr = DSView(ds,viewer);CHKERRQ(ierr);
ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
if (verbose) {
ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
}
/* Fill matrices */
ierr = DSGetArray(ds,DS_MAT_E0,&Id);CHKERRQ(ierr);
for (i=0;i<n;i++) Id[i+i*ld]=1.0;
ierr = DSRestoreArray(ds,DS_MAT_E0,&Id);CHKERRQ(ierr);
h = PETSC_PI/(PetscReal)(n+1);
ierr = DSGetArray(ds,DS_MAT_E1,&A);CHKERRQ(ierr);
for (i=0;i<n;i++) A[i+i*ld]=-2.0/(h*h)+a;
for (i=1;i<n;i++) {
A[i+(i-1)*ld]=1.0/(h*h);
A[(i-1)+i*ld]=1.0/(h*h);
}
ierr = DSRestoreArray(ds,DS_MAT_E1,&A);CHKERRQ(ierr);
ierr = DSGetArray(ds,DS_MAT_E2,&B);CHKERRQ(ierr);
for (i=0;i<n;i++) {
xi = (i+1)*h;
B[i+i*ld] = -4.1+xi*(1.0-PetscExpReal(xi-PETSC_PI));
}
ierr = DSRestoreArray(ds,DS_MAT_E2,&B);CHKERRQ(ierr);
if (verbose) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"Initial - - - - - - - - -\n");CHKERRQ(ierr);
ierr = DSView(ds,viewer);CHKERRQ(ierr);
}
/* Solve */
ierr = PetscMalloc2(n,&wr,n,&wi);CHKERRQ(ierr);
ierr = DSSolve(ds,wr,wi);CHKERRQ(ierr);
if (verbose) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"After solve - - - - - - - - -\n");CHKERRQ(ierr);
ierr = DSView(ds,viewer);CHKERRQ(ierr);
}
/* Print first eigenvalue */
ierr = PetscPrintf(PETSC_COMM_WORLD,"Computed eigenvalue =\n",n);CHKERRQ(ierr);
nev = 1;
for (i=0;i<nev;i++) {
#if defined(PETSC_USE_COMPLEX)
re = PetscRealPart(wr[i]);
im = PetscImaginaryPart(wr[i]);
#else
re = wr[i];
im = wi[i];
#endif
if (PetscAbs(im)<1e-10) {
ierr = PetscViewerASCIIPrintf(viewer," %.5f\n",(double)re);CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIIPrintf(viewer," %.5f%+.5fi\n",(double)re,(double)im);CHKERRQ(ierr);
}
}
ierr = PetscFree2(wr,wi);CHKERRQ(ierr);
ierr = FNDestroy(&f1);CHKERRQ(ierr);
ierr = FNDestroy(&f2);CHKERRQ(ierr);
ierr = FNDestroy(&f3);CHKERRQ(ierr);
ierr = DSDestroy(&ds);CHKERRQ(ierr);
ierr = SlepcFinalize();
return 0;
}
PetscErrorCode EPSSolve_Lanczos(EPS eps)
{
EPS_LANCZOS *lanczos = (EPS_LANCZOS*)eps->data;
PetscErrorCode ierr;
PetscInt nconv,i,j,k,l,x,n,*perm,restart,ncv=eps->ncv,r,ld;
Vec vi,vj,w;
Mat U;
PetscScalar *Y,*ritz,stmp;
PetscReal *d,*e,*bnd,anorm,beta,norm,rtmp,resnorm;
PetscBool breakdown;
char *conv,ctmp;
PetscFunctionBegin;
ierr = DSGetLeadingDimension(eps->ds,&ld);CHKERRQ(ierr);
ierr = PetscMalloc4(ncv,&ritz,ncv,&bnd,ncv,&perm,ncv,&conv);CHKERRQ(ierr);
/* The first Lanczos vector is the normalized initial vector */
ierr = EPSGetStartVector(eps,0,NULL);CHKERRQ(ierr);
anorm = -1.0;
nconv = 0;
/* Restart loop */
while (eps->reason == EPS_CONVERGED_ITERATING) {
eps->its++;
/* Compute an ncv-step Lanczos factorization */
n = PetscMin(nconv+eps->mpd,ncv);
ierr = DSGetArrayReal(eps->ds,DS_MAT_T,&d);CHKERRQ(ierr);
e = d + ld;
ierr = EPSBasicLanczos(eps,d,e,nconv,&n,&breakdown,anorm);CHKERRQ(ierr);
beta = e[n-1];
ierr = DSRestoreArrayReal(eps->ds,DS_MAT_T,&d);CHKERRQ(ierr);
ierr = DSSetDimensions(eps->ds,n,0,nconv,0);CHKERRQ(ierr);
ierr = DSSetState(eps->ds,DS_STATE_INTERMEDIATE);CHKERRQ(ierr);
ierr = BVSetActiveColumns(eps->V,nconv,n);CHKERRQ(ierr);
/* Solve projected problem */
ierr = DSSolve(eps->ds,ritz,NULL);CHKERRQ(ierr);
ierr = DSSort(eps->ds,ritz,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
/* Estimate ||A|| */
for (i=nconv;i<n;i++)
anorm = PetscMax(anorm,PetscAbsReal(PetscRealPart(ritz[i])));
/* Compute residual norm estimates as beta*abs(Y(m,:)) + eps*||A|| */
ierr = DSGetArray(eps->ds,DS_MAT_Q,&Y);CHKERRQ(ierr);
for (i=nconv;i<n;i++) {
resnorm = beta*PetscAbsScalar(Y[n-1+i*ld]) + PETSC_MACHINE_EPSILON*anorm;
ierr = (*eps->converged)(eps,ritz[i],eps->eigi[i],resnorm,&bnd[i],eps->convergedctx);CHKERRQ(ierr);
if (bnd[i]<eps->tol) conv[i] = 'C';
else conv[i] = 'N';
}
ierr = DSRestoreArray(eps->ds,DS_MAT_Q,&Y);CHKERRQ(ierr);
/* purge repeated ritz values */
if (lanczos->reorthog == EPS_LANCZOS_REORTHOG_LOCAL) {
for (i=nconv+1;i<n;i++) {
if (conv[i] == 'C' && PetscAbsScalar((ritz[i]-ritz[i-1])/ritz[i]) < eps->tol) conv[i] = 'R';
}
}
/* Compute restart vector */
if (breakdown) {
ierr = PetscInfo2(eps,"Breakdown in Lanczos method (it=%D norm=%g)\n",eps->its,(double)beta);CHKERRQ(ierr);
} else {
restart = nconv;
while (restart<n && conv[restart] != 'N') restart++;
if (restart >= n) {
breakdown = PETSC_TRUE;
} else {
for (i=restart+1;i<n;i++) {
if (conv[i] == 'N') {
ierr = SlepcSCCompare(eps->sc,ritz[restart],0.0,ritz[i],0.0,&r);CHKERRQ(ierr);
if (r>0) restart = i;
}
}
ierr = DSGetArray(eps->ds,DS_MAT_Q,&Y);CHKERRQ(ierr);
ierr = BVMultColumn(eps->V,1.0,0.0,n,Y+restart*ld+nconv);CHKERRQ(ierr);
ierr = DSRestoreArray(eps->ds,DS_MAT_Q,&Y);CHKERRQ(ierr);
}
}
/* Count and put converged eigenvalues first */
for (i=nconv;i<n;i++) perm[i] = i;
for (k=nconv;k<n;k++) {
if (conv[perm[k]] != 'C') {
j = k + 1;
while (j<n && conv[perm[j]] != 'C') j++;
if (j>=n) break;
l = perm[k]; perm[k] = perm[j]; perm[j] = l;
}
}
/* Sort eigenvectors according to permutation */
ierr = DSGetArray(eps->ds,DS_MAT_Q,&Y);CHKERRQ(ierr);
for (i=nconv;i<k;i++) {
x = perm[i];
if (x != i) {
j = i + 1;
while (perm[j] != i) j++;
/* swap eigenvalues i and j */
stmp = ritz[x]; ritz[x] = ritz[i]; ritz[i] = stmp;
rtmp = bnd[x]; bnd[x] = bnd[i]; bnd[i] = rtmp;
ctmp = conv[x]; conv[x] = conv[i]; conv[i] = ctmp;
perm[j] = x; perm[i] = i;
/* swap eigenvectors i and j */
for (l=0;l<n;l++) {
stmp = Y[l+x*ld]; Y[l+x*ld] = Y[l+i*ld]; Y[l+i*ld] = stmp;
}
}
}
ierr = DSRestoreArray(eps->ds,DS_MAT_Q,&Y);CHKERRQ(ierr);
/* compute converged eigenvectors */
ierr = DSGetMat(eps->ds,DS_MAT_Q,&U);CHKERRQ(ierr);
ierr = BVMultInPlace(eps->V,U,nconv,k);CHKERRQ(ierr);
ierr = MatDestroy(&U);CHKERRQ(ierr);
/* purge spurious ritz values */
if (lanczos->reorthog == EPS_LANCZOS_REORTHOG_LOCAL) {
for (i=nconv;i<k;i++) {
ierr = BVGetColumn(eps->V,i,&vi);CHKERRQ(ierr);
ierr = VecNorm(vi,NORM_2,&norm);CHKERRQ(ierr);
ierr = VecScale(vi,1.0/norm);CHKERRQ(ierr);
w = eps->work[0];
ierr = STApply(eps->st,vi,w);CHKERRQ(ierr);
ierr = VecAXPY(w,-ritz[i],vi);CHKERRQ(ierr);
ierr = BVRestoreColumn(eps->V,i,&vi);CHKERRQ(ierr);
ierr = VecNorm(w,NORM_2,&norm);CHKERRQ(ierr);
ierr = (*eps->converged)(eps,ritz[i],eps->eigi[i],norm,&bnd[i],eps->convergedctx);CHKERRQ(ierr);
if (bnd[i]>=eps->tol) conv[i] = 'S';
}
for (i=nconv;i<k;i++) {
if (conv[i] != 'C') {
j = i + 1;
while (j<k && conv[j] != 'C') j++;
if (j>=k) break;
/* swap eigenvalues i and j */
stmp = ritz[j]; ritz[j] = ritz[i]; ritz[i] = stmp;
rtmp = bnd[j]; bnd[j] = bnd[i]; bnd[i] = rtmp;
ctmp = conv[j]; conv[j] = conv[i]; conv[i] = ctmp;
/* swap eigenvectors i and j */
ierr = BVGetColumn(eps->V,i,&vi);CHKERRQ(ierr);
ierr = BVGetColumn(eps->V,j,&vj);CHKERRQ(ierr);
ierr = VecSwap(vi,vj);CHKERRQ(ierr);
ierr = BVRestoreColumn(eps->V,i,&vi);CHKERRQ(ierr);
ierr = BVRestoreColumn(eps->V,j,&vj);CHKERRQ(ierr);
}
}
k = i;
}
/* store ritz values and estimated errors */
for (i=nconv;i<n;i++) {
eps->eigr[i] = ritz[i];
eps->errest[i] = bnd[i];
}
ierr = EPSMonitor(eps,eps->its,nconv,eps->eigr,eps->eigi,eps->errest,n);CHKERRQ(ierr);
nconv = k;
if (eps->its >= eps->max_it) eps->reason = EPS_DIVERGED_ITS;
if (nconv >= eps->nev) eps->reason = EPS_CONVERGED_TOL;
if (eps->reason == EPS_CONVERGED_ITERATING) { /* copy restart vector */
ierr = BVCopyColumn(eps->V,n,nconv);CHKERRQ(ierr);
if (lanczos->reorthog == EPS_LANCZOS_REORTHOG_LOCAL && !breakdown) {
/* Reorthonormalize restart vector */
ierr = BVOrthogonalizeColumn(eps->V,nconv,NULL,&norm,&breakdown);CHKERRQ(ierr);
ierr = BVScaleColumn(eps->V,nconv,1.0/norm);CHKERRQ(ierr);
}
if (breakdown) {
/* Use random vector for restarting */
ierr = PetscInfo(eps,"Using random vector for restart\n");CHKERRQ(ierr);
ierr = EPSGetStartVector(eps,nconv,&breakdown);CHKERRQ(ierr);
}
if (breakdown) { /* give up */
eps->reason = EPS_DIVERGED_BREAKDOWN;
ierr = PetscInfo(eps,"Unable to generate more start vectors\n");CHKERRQ(ierr);
}
}
}
eps->nconv = nconv;
ierr = PetscFree4(ritz,bnd,perm,conv);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode EPSSolve_Arnoldi(EPS eps)
{
PetscErrorCode ierr;
PetscInt k,nv,ld;
Mat U;
PetscScalar *H,*X;
PetscReal beta,gamma=1.0;
PetscBool breakdown,harmonic,refined;
BVOrthogRefineType orthog_ref;
EPS_ARNOLDI *arnoldi = (EPS_ARNOLDI*)eps->data;
PetscFunctionBegin;
ierr = DSGetLeadingDimension(eps->ds,&ld);CHKERRQ(ierr);
ierr = DSGetRefined(eps->ds,&refined);CHKERRQ(ierr);
harmonic = (eps->extraction==EPS_HARMONIC || eps->extraction==EPS_REFINED_HARMONIC)?PETSC_TRUE:PETSC_FALSE;
ierr = BVGetOrthogonalization(eps->V,NULL,&orthog_ref,NULL);CHKERRQ(ierr);
/* Get the starting Arnoldi vector */
ierr = EPSGetStartVector(eps,0,NULL);CHKERRQ(ierr);
/* Restart loop */
while (eps->reason == EPS_CONVERGED_ITERATING) {
eps->its++;
/* Compute an nv-step Arnoldi factorization */
nv = PetscMin(eps->nconv+eps->mpd,eps->ncv);
ierr = DSSetDimensions(eps->ds,nv,0,eps->nconv,0);CHKERRQ(ierr);
ierr = DSGetArray(eps->ds,DS_MAT_A,&H);CHKERRQ(ierr);
if (!arnoldi->delayed) {
ierr = EPSBasicArnoldi(eps,PETSC_FALSE,H,ld,eps->nconv,&nv,&beta,&breakdown);CHKERRQ(ierr);
} else SETERRQ(PetscObjectComm((PetscObject)eps),1,"Not implemented");
/*if (orthog_ref == BV_ORTHOG_REFINE_NEVER) {
ierr = EPSDelayedArnoldi1(eps,H,ld,eps->V,eps->nconv,&nv,f,&beta,&breakdown);CHKERRQ(ierr);
} else {
ierr = EPSDelayedArnoldi(eps,H,ld,eps->V,eps->nconv,&nv,f,&beta,&breakdown);CHKERRQ(ierr);
}*/
ierr = DSRestoreArray(eps->ds,DS_MAT_A,&H);CHKERRQ(ierr);
ierr = DSSetState(eps->ds,DS_STATE_INTERMEDIATE);CHKERRQ(ierr);
ierr = BVSetActiveColumns(eps->V,eps->nconv,nv);CHKERRQ(ierr);
/* Compute translation of Krylov decomposition if harmonic extraction used */
if (harmonic) {
ierr = DSTranslateHarmonic(eps->ds,eps->target,beta,PETSC_FALSE,NULL,&gamma);CHKERRQ(ierr);
}
/* Solve projected problem */
ierr = DSSolve(eps->ds,eps->eigr,eps->eigi);CHKERRQ(ierr);
ierr = DSSort(eps->ds,eps->eigr,eps->eigi,NULL,NULL,NULL);CHKERRQ(ierr);
ierr = DSUpdateExtraRow(eps->ds);CHKERRQ(ierr);
/* Check convergence */
ierr = EPSKrylovConvergence(eps,PETSC_FALSE,eps->nconv,nv-eps->nconv,beta,gamma,&k);CHKERRQ(ierr);
if (refined) {
ierr = DSGetArray(eps->ds,DS_MAT_X,&X);CHKERRQ(ierr);
ierr = BVMultColumn(eps->V,1.0,0.0,k,X+k*ld);CHKERRQ(ierr);
ierr = DSRestoreArray(eps->ds,DS_MAT_X,&X);CHKERRQ(ierr);
ierr = DSGetMat(eps->ds,DS_MAT_Q,&U);CHKERRQ(ierr);
ierr = BVMultInPlace(eps->V,U,eps->nconv,nv);CHKERRQ(ierr);
ierr = MatDestroy(&U);CHKERRQ(ierr);
ierr = BVOrthogonalizeColumn(eps->V,k,NULL,NULL,NULL);CHKERRQ(ierr);
} else {
ierr = DSGetMat(eps->ds,DS_MAT_Q,&U);CHKERRQ(ierr);
ierr = BVMultInPlace(eps->V,U,eps->nconv,nv);CHKERRQ(ierr);
ierr = MatDestroy(&U);CHKERRQ(ierr);
}
eps->nconv = k;
ierr = EPSMonitor(eps,eps->its,eps->nconv,eps->eigr,eps->eigi,eps->errest,nv);CHKERRQ(ierr);
if (breakdown && k<eps->nev) {
ierr = PetscInfo2(eps,"Breakdown in Arnoldi method (it=%D norm=%g)\n",eps->its,(double)beta);CHKERRQ(ierr);
ierr = EPSGetStartVector(eps,k,&breakdown);CHKERRQ(ierr);
if (breakdown) {
eps->reason = EPS_DIVERGED_BREAKDOWN;
ierr = PetscInfo(eps,"Unable to generate more start vectors\n");CHKERRQ(ierr);
}
}
if (eps->its >= eps->max_it) eps->reason = EPS_DIVERGED_ITS;
if (eps->nconv >= eps->nev) eps->reason = EPS_CONVERGED_TOL;
}
/* truncate Schur decomposition and change the state to raw so that
PSVectors() computes eigenvectors from scratch */
ierr = DSSetDimensions(eps->ds,eps->nconv,0,0,0);CHKERRQ(ierr);
ierr = DSSetState(eps->ds,DS_STATE_RAW);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
PetscErrorCode ierr;
DS ds;
SlepcSC sc;
PetscReal *T,*s,re,im;
PetscScalar *eigr,*eigi;
PetscInt i,n=10,l=2,k=5,ld;
PetscViewer viewer;
PetscBool verbose;
SlepcInitialize(&argc,&argv,(char*)0,help);
ierr = PetscOptionsGetInt(NULL,"-n",&n,NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Solve a Dense System of type GHIEP with compact storage - dimension %D.\n",n);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,"-l",&l,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,"-k",&k,NULL);CHKERRQ(ierr);
if (l>n || k>n || l>k) SETERRQ(PETSC_COMM_WORLD,1,"Wrong value of dimensions");
ierr = PetscOptionsHasName(NULL,"-verbose",&verbose);CHKERRQ(ierr);
/* Create DS object */
ierr = DSCreate(PETSC_COMM_WORLD,&ds);CHKERRQ(ierr);
ierr = DSSetType(ds,DSGHIEP);CHKERRQ(ierr);
ierr = DSSetFromOptions(ds);CHKERRQ(ierr);
ld = n+2; /* test leading dimension larger than n */
ierr = DSAllocate(ds,ld);CHKERRQ(ierr);
ierr = DSSetDimensions(ds,n,0,l,k);CHKERRQ(ierr);
ierr = DSSetCompact(ds,PETSC_TRUE);CHKERRQ(ierr);
/* Set up viewer */
ierr = PetscViewerASCIIGetStdout(PETSC_COMM_WORLD,&viewer);CHKERRQ(ierr);
ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_INFO_DETAIL);CHKERRQ(ierr);
ierr = DSView(ds,viewer);CHKERRQ(ierr);
ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
if (verbose) {
ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
}
/* Fill arrow-tridiagonal matrix */
ierr = DSGetArrayReal(ds,DS_MAT_T,&T);CHKERRQ(ierr);
ierr = DSGetArrayReal(ds,DS_MAT_D,&s);CHKERRQ(ierr);
for (i=0;i<n;i++) T[i] = (PetscReal)(i+1);
for (i=k;i<n-1;i++) T[i+ld] = 1.0;
for (i=l;i<k;i++) T[i+2*ld] = 1.0;
T[2*ld+l+1] = -7; T[ld+k+1] = -7;
/* Signature matrix */
for (i=0;i<n;i++) s[i] = 1.0;
s[l+1] = -1.0;
s[k+1] = -1.0;
ierr = DSRestoreArrayReal(ds,DS_MAT_T,&T);CHKERRQ(ierr);
ierr = DSRestoreArrayReal(ds,DS_MAT_D,&s);CHKERRQ(ierr);
if (l==0 && k==0) {
ierr = DSSetState(ds,DS_STATE_INTERMEDIATE);CHKERRQ(ierr);
} else {
ierr = DSSetState(ds,DS_STATE_RAW);CHKERRQ(ierr);
}
if (verbose) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"Initial - - - - - - - - -\n");CHKERRQ(ierr);
ierr = DSView(ds,viewer);CHKERRQ(ierr);
}
/* Solve */
ierr = PetscCalloc2(n,&eigr,n,&eigi);CHKERRQ(ierr);
ierr = DSGetSlepcSC(ds,&sc);CHKERRQ(ierr);
sc->comparison = SlepcCompareLargestMagnitude;
sc->comparisonctx = NULL;
sc->map = NULL;
sc->mapobj = NULL;
ierr = DSSolve(ds,eigr,eigi);CHKERRQ(ierr);
ierr = DSSort(ds,eigr,eigi,NULL,NULL,NULL);CHKERRQ(ierr);
if (verbose) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"After solve - - - - - - - - -\n");CHKERRQ(ierr);
ierr = DSView(ds,viewer);CHKERRQ(ierr);
}
/* Print eigenvalues */
ierr = PetscPrintf(PETSC_COMM_WORLD,"Computed eigenvalues =\n",n);CHKERRQ(ierr);
for (i=0;i<n;i++) {
#if defined(PETSC_USE_COMPLEX)
re = PetscRealPart(eigr[i]);
im = PetscImaginaryPart(eigr[i]);
#else
re = eigr[i];
im = eigi[i];
#endif
if (PetscAbs(im)<1e-10) {
ierr = PetscViewerASCIIPrintf(viewer," %.5f\n",(double)re);CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIIPrintf(viewer," %.5f%+.5fi\n",(double)re,(double)im);CHKERRQ(ierr);
}
}
ierr = PetscFree2(eigr,eigi);CHKERRQ(ierr);
ierr = DSDestroy(&ds);CHKERRQ(ierr);
ierr = SlepcFinalize();
return 0;
}
PetscErrorCode EPSSolve_KrylovSchur_Default(EPS eps)
{
PetscErrorCode ierr;
EPS_KRYLOVSCHUR *ctx = (EPS_KRYLOVSCHUR*)eps->data;
PetscInt i,j,*pj,k,l,nv,ld;
Mat U;
PetscScalar *S,*Q,*g;
PetscReal beta,gamma=1.0;
PetscBool breakdown,harmonic;
PetscFunctionBegin;
ierr = DSGetLeadingDimension(eps->ds,&ld);CHKERRQ(ierr);
harmonic = (eps->extraction==EPS_HARMONIC || eps->extraction==EPS_REFINED_HARMONIC)?PETSC_TRUE:PETSC_FALSE;
if (harmonic) { ierr = PetscMalloc1(ld,&g);CHKERRQ(ierr); }
if (eps->arbitrary) pj = &j;
else pj = NULL;
/* Get the starting Arnoldi vector */
ierr = EPSGetStartVector(eps,0,NULL);CHKERRQ(ierr);
l = 0;
/* Restart loop */
while (eps->reason == EPS_CONVERGED_ITERATING) {
eps->its++;
/* Compute an nv-step Arnoldi factorization */
nv = PetscMin(eps->nconv+eps->mpd,eps->ncv);
ierr = DSGetArray(eps->ds,DS_MAT_A,&S);CHKERRQ(ierr);
ierr = EPSBasicArnoldi(eps,PETSC_FALSE,S,ld,eps->nconv+l,&nv,&beta,&breakdown);CHKERRQ(ierr);
ierr = DSRestoreArray(eps->ds,DS_MAT_A,&S);CHKERRQ(ierr);
ierr = DSSetDimensions(eps->ds,nv,0,eps->nconv,eps->nconv+l);CHKERRQ(ierr);
if (l==0) {
ierr = DSSetState(eps->ds,DS_STATE_INTERMEDIATE);CHKERRQ(ierr);
} else {
ierr = DSSetState(eps->ds,DS_STATE_RAW);CHKERRQ(ierr);
}
ierr = BVSetActiveColumns(eps->V,eps->nconv,nv);CHKERRQ(ierr);
/* Compute translation of Krylov decomposition if harmonic extraction used */
if (harmonic) {
ierr = DSTranslateHarmonic(eps->ds,eps->target,beta,PETSC_FALSE,g,&gamma);CHKERRQ(ierr);
}
/* Solve projected problem */
ierr = DSSolve(eps->ds,eps->eigr,eps->eigi);CHKERRQ(ierr);
if (eps->arbitrary) {
ierr = EPSGetArbitraryValues(eps,eps->rr,eps->ri);CHKERRQ(ierr);
j=1;
}
ierr = DSSort(eps->ds,eps->eigr,eps->eigi,eps->rr,eps->ri,pj);CHKERRQ(ierr);
/* Check convergence */
ierr = EPSKrylovConvergence(eps,PETSC_FALSE,eps->nconv,nv-eps->nconv,beta,gamma,&k);CHKERRQ(ierr);
if (eps->its >= eps->max_it) eps->reason = EPS_DIVERGED_ITS;
if (k >= eps->nev) eps->reason = EPS_CONVERGED_TOL;
/* Update l */
if (eps->reason != EPS_CONVERGED_ITERATING || breakdown) l = 0;
else {
l = PetscMax(1,(PetscInt)((nv-k)*ctx->keep));
#if !defined(PETSC_USE_COMPLEX)
ierr = DSGetArray(eps->ds,DS_MAT_A,&S);CHKERRQ(ierr);
if (S[k+l+(k+l-1)*ld] != 0.0) {
if (k+l<nv-1) l = l+1;
else l = l-1;
}
ierr = DSRestoreArray(eps->ds,DS_MAT_A,&S);CHKERRQ(ierr);
#endif
}
if (eps->reason == EPS_CONVERGED_ITERATING) {
if (breakdown) {
/* Start a new Arnoldi factorization */
ierr = PetscInfo2(eps,"Breakdown in Krylov-Schur method (it=%D norm=%g)\n",eps->its,(double)beta);CHKERRQ(ierr);
if (k<eps->nev) {
ierr = EPSGetStartVector(eps,k,&breakdown);CHKERRQ(ierr);
if (breakdown) {
eps->reason = EPS_DIVERGED_BREAKDOWN;
ierr = PetscInfo(eps,"Unable to generate more start vectors\n");CHKERRQ(ierr);
}
}
} else {
/* Undo translation of Krylov decomposition */
if (harmonic) {
ierr = DSSetDimensions(eps->ds,nv,0,k,l);CHKERRQ(ierr);
ierr = DSTranslateHarmonic(eps->ds,0.0,beta,PETSC_TRUE,g,&gamma);CHKERRQ(ierr);
/* gamma u^ = u - U*g~ */
ierr = BVMultColumn(eps->V,-1.0,1.0,nv,g);CHKERRQ(ierr);
ierr = BVScaleColumn(eps->V,nv,1.0/gamma);CHKERRQ(ierr);
}
/* Prepare the Rayleigh quotient for restart */
ierr = DSGetArray(eps->ds,DS_MAT_A,&S);CHKERRQ(ierr);
ierr = DSGetArray(eps->ds,DS_MAT_Q,&Q);CHKERRQ(ierr);
for (i=k;i<k+l;i++) {
S[k+l+i*ld] = Q[nv-1+i*ld]*beta*gamma;
}
ierr = DSRestoreArray(eps->ds,DS_MAT_A,&S);CHKERRQ(ierr);
ierr = DSRestoreArray(eps->ds,DS_MAT_Q,&Q);CHKERRQ(ierr);
}
}
/* Update the corresponding vectors V(:,idx) = V*Q(:,idx) */
ierr = DSGetMat(eps->ds,DS_MAT_Q,&U);CHKERRQ(ierr);
ierr = BVMultInPlace(eps->V,U,eps->nconv,k+l);CHKERRQ(ierr);
ierr = MatDestroy(&U);CHKERRQ(ierr);
if (eps->reason == EPS_CONVERGED_ITERATING && !breakdown) {
ierr = BVCopyColumn(eps->V,nv,k+l);CHKERRQ(ierr);
}
eps->nconv = k;
ierr = EPSMonitor(eps,eps->its,eps->nconv,eps->eigr,eps->eigi,eps->errest,nv);CHKERRQ(ierr);
}
if (harmonic) { ierr = PetscFree(g);CHKERRQ(ierr); }
/* truncate Schur decomposition and change the state to raw so that
PSVectors() computes eigenvectors from scratch */
ierr = DSSetDimensions(eps->ds,eps->nconv,0,0,0);CHKERRQ(ierr);
ierr = DSSetState(eps->ds,DS_STATE_RAW);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
PetscErrorCode ierr;
DS ds;
SlepcSC sc;
PetscScalar *A,*eig;
PetscInt i,j,n,ld,bs,maxbw=3,nblks=8;
PetscViewer viewer;
PetscBool verbose;
SlepcInitialize(&argc,&argv,(char*)0,help);
ierr = PetscOptionsGetInt(NULL,"-maxbw",&maxbw,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,"-nblks",&nblks,NULL);CHKERRQ(ierr);
n = maxbw*nblks;
bs = maxbw;
ierr = PetscPrintf(PETSC_COMM_WORLD,"Solve a block HEP Dense System - dimension %D (bandwidth=%D, blocks=%D).\n",n,maxbw,nblks);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,"-verbose",&verbose);CHKERRQ(ierr);
/* Create DS object */
ierr = DSCreate(PETSC_COMM_WORLD,&ds);CHKERRQ(ierr);
ierr = DSSetType(ds,DSHEP);CHKERRQ(ierr);
ierr = DSSetMethod(ds,3);CHKERRQ(ierr); /* Select block divide-and-conquer */
ierr = DSSetBlockSize(ds,bs);CHKERRQ(ierr);
ierr = DSSetFromOptions(ds);CHKERRQ(ierr);
ld = n;
ierr = DSAllocate(ds,ld);CHKERRQ(ierr);
ierr = DSSetDimensions(ds,n,0,0,0);CHKERRQ(ierr);
/* Set up viewer */
ierr = PetscViewerASCIIGetStdout(PETSC_COMM_WORLD,&viewer);CHKERRQ(ierr);
ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_INFO_DETAIL);CHKERRQ(ierr);
ierr = DSView(ds,viewer);CHKERRQ(ierr);
ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
if (verbose) {
ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
}
/* Fill with a symmetric band Toeplitz matrix */
ierr = DSGetArray(ds,DS_MAT_A,&A);CHKERRQ(ierr);
for (i=0;i<n;i++) A[i+i*ld]=2.0;
for (j=1;j<=bs;j++) {
for (i=0;i<n-j;i++) { A[i+(i+j)*ld]=1.0; A[(i+j)+i*ld]=1.0; }
}
ierr = DSRestoreArray(ds,DS_MAT_A,&A);CHKERRQ(ierr);
ierr = DSSetState(ds,DS_STATE_RAW);CHKERRQ(ierr);
if (verbose) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"Initial - - - - - - - - -\n");CHKERRQ(ierr);
ierr = DSView(ds,viewer);CHKERRQ(ierr);
}
/* Solve */
ierr = PetscMalloc1(n,&eig);CHKERRQ(ierr);
ierr = DSGetSlepcSC(ds,&sc);CHKERRQ(ierr);
sc->comparison = SlepcCompareSmallestReal;
sc->comparisonctx = NULL;
sc->map = NULL;
sc->mapobj = NULL;
ierr = DSSolve(ds,eig,NULL);CHKERRQ(ierr);
ierr = DSSort(ds,eig,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
if (verbose) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"After solve - - - - - - - - -\n");CHKERRQ(ierr);
ierr = DSView(ds,viewer);CHKERRQ(ierr);
}
/* Print eigenvalues */
ierr = PetscPrintf(PETSC_COMM_WORLD,"Computed eigenvalues =\n",n);CHKERRQ(ierr);
for (i=0;i<n;i++) {
ierr = PetscViewerASCIIPrintf(viewer," %.5f\n",(double)PetscRealPart(eig[i]));CHKERRQ(ierr);
}
ierr = PetscFree(eig);CHKERRQ(ierr);
ierr = DSDestroy(&ds);CHKERRQ(ierr);
ierr = SlepcFinalize();
return 0;
}
PetscErrorCode NEPSolve_NArnoldi(NEP nep)
{
PetscErrorCode ierr;
Mat T=nep->function,Tsigma;
Vec f,r=nep->work[0],x=nep->work[1],w=nep->work[2];
PetscScalar *X,lambda;
PetscReal beta,resnorm=0.0,nrm;
PetscInt n;
PetscBool breakdown;
KSPConvergedReason kspreason;
PetscFunctionBegin;
/* get initial space and shift */
ierr = NEPGetDefaultShift(nep,&lambda);CHKERRQ(ierr);
if (!nep->nini) {
ierr = BVSetRandomColumn(nep->V,0,nep->rand);CHKERRQ(ierr);
ierr = BVNormColumn(nep->V,0,NORM_2,&nrm);CHKERRQ(ierr);
ierr = BVScaleColumn(nep->V,0,1.0/nrm);CHKERRQ(ierr);
n = 1;
} else n = nep->nini;
/* build projected matrices for initial space */
ierr = DSSetDimensions(nep->ds,n,0,0,0);CHKERRQ(ierr);
ierr = NEPProjectOperator(nep,0,n);CHKERRQ(ierr);
/* prepare linear solver */
ierr = NEPComputeFunction(nep,lambda,T,T);CHKERRQ(ierr);
ierr = MatDuplicate(T,MAT_COPY_VALUES,&Tsigma);CHKERRQ(ierr);
ierr = KSPSetOperators(nep->ksp,Tsigma,Tsigma);CHKERRQ(ierr);
/* Restart loop */
while (nep->reason == NEP_CONVERGED_ITERATING) {
nep->its++;
/* solve projected problem */
ierr = DSSetDimensions(nep->ds,n,0,0,0);CHKERRQ(ierr);
ierr = DSSetState(nep->ds,DS_STATE_RAW);CHKERRQ(ierr);
ierr = DSSolve(nep->ds,nep->eigr,NULL);CHKERRQ(ierr);
lambda = nep->eigr[0];
/* compute Ritz vector, x = V*s */
ierr = DSGetArray(nep->ds,DS_MAT_X,&X);CHKERRQ(ierr);
ierr = BVSetActiveColumns(nep->V,0,n);CHKERRQ(ierr);
ierr = BVMultVec(nep->V,1.0,0.0,x,X);CHKERRQ(ierr);
ierr = DSRestoreArray(nep->ds,DS_MAT_X,&X);CHKERRQ(ierr);
/* compute the residual, r = T(lambda)*x */
ierr = NEPApplyFunction(nep,lambda,x,w,r,NULL,NULL);CHKERRQ(ierr);
/* convergence test */
ierr = VecNorm(r,NORM_2,&resnorm);CHKERRQ(ierr);
nep->errest[nep->nconv] = resnorm;
if (resnorm<=nep->rtol) {
ierr = BVInsertVec(nep->V,nep->nconv,x);CHKERRQ(ierr);
nep->nconv = nep->nconv + 1;
nep->reason = NEP_CONVERGED_FNORM_RELATIVE;
}
ierr = NEPMonitor(nep,nep->its,nep->nconv,nep->eigr,nep->errest,1);CHKERRQ(ierr);
if (nep->reason == NEP_CONVERGED_ITERATING) {
/* continuation vector: f = T(sigma)\r */
ierr = BVGetColumn(nep->V,n,&f);CHKERRQ(ierr);
ierr = NEP_KSPSolve(nep,r,f);CHKERRQ(ierr);
ierr = BVRestoreColumn(nep->V,n,&f);CHKERRQ(ierr);
ierr = KSPGetConvergedReason(nep->ksp,&kspreason);CHKERRQ(ierr);
if (kspreason<0) {
ierr = PetscInfo1(nep,"iter=%D, linear solve failed, stopping solve\n",nep->its);CHKERRQ(ierr);
nep->reason = NEP_DIVERGED_LINEAR_SOLVE;
break;
}
/* orthonormalize */
ierr = BVOrthogonalizeColumn(nep->V,n,NULL,&beta,&breakdown);CHKERRQ(ierr);
if (breakdown || beta==0.0) {
ierr = PetscInfo1(nep,"iter=%D, orthogonalization failed, stopping solve\n",nep->its);CHKERRQ(ierr);
nep->reason = NEP_DIVERGED_BREAKDOWN;
break;
}
ierr = BVScaleColumn(nep->V,n,1.0/beta);CHKERRQ(ierr);
/* update projected matrices */
ierr = DSSetDimensions(nep->ds,n+1,0,0,0);CHKERRQ(ierr);
ierr = NEPProjectOperator(nep,n,n+1);CHKERRQ(ierr);
n++;
}
if (nep->its >= nep->max_it) nep->reason = NEP_DIVERGED_MAX_IT;
}
ierr = MatDestroy(&Tsigma);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode SVDSolve_TRLanczos(SVD svd)
{
PetscErrorCode ierr;
SVD_TRLANCZOS *lanczos = (SVD_TRLANCZOS*)svd->data;
PetscReal *alpha,*beta,lastbeta,norm;
PetscScalar *Q,*swork=NULL,*w;
PetscInt i,k,l,nv,ld;
Mat U,VT;
PetscBool conv;
BVOrthogType orthog;
PetscFunctionBegin;
/* allocate working space */
ierr = DSGetLeadingDimension(svd->ds,&ld);CHKERRQ(ierr);
ierr = BVGetOrthogonalization(svd->V,&orthog,NULL,NULL);CHKERRQ(ierr);
ierr = PetscMalloc1(ld,&w);CHKERRQ(ierr);
if (lanczos->oneside && orthog == BV_ORTHOG_CGS) {
ierr = PetscMalloc1(svd->ncv+1,&swork);CHKERRQ(ierr);
}
/* normalize start vector */
if (!svd->nini) {
ierr = BVSetRandomColumn(svd->V,0,svd->rand);CHKERRQ(ierr);
ierr = BVNormColumn(svd->V,0,NORM_2,&norm);CHKERRQ(ierr);
ierr = BVScaleColumn(svd->V,0,1.0/norm);CHKERRQ(ierr);
}
l = 0;
while (svd->reason == SVD_CONVERGED_ITERATING) {
svd->its++;
/* inner loop */
nv = PetscMin(svd->nconv+svd->mpd,svd->ncv);
ierr = BVSetActiveColumns(svd->V,svd->nconv,nv);CHKERRQ(ierr);
ierr = BVSetActiveColumns(svd->U,svd->nconv,nv);CHKERRQ(ierr);
ierr = DSGetArrayReal(svd->ds,DS_MAT_T,&alpha);CHKERRQ(ierr);
beta = alpha + ld;
if (lanczos->oneside) {
if (orthog == BV_ORTHOG_MGS) {
ierr = SVDOneSideTRLanczosMGS(svd,alpha,beta,svd->V,svd->U,svd->nconv,l,nv);CHKERRQ(ierr);
} else {
ierr = SVDOneSideTRLanczosCGS(svd,alpha,beta,svd->V,svd->U,svd->nconv,l,nv,swork);CHKERRQ(ierr);
}
} else {
ierr = SVDTwoSideLanczos(svd,alpha,beta,svd->V,svd->U,svd->nconv+l,nv);CHKERRQ(ierr);
}
lastbeta = beta[nv-1];
ierr = DSRestoreArrayReal(svd->ds,DS_MAT_T,&alpha);CHKERRQ(ierr);
ierr = BVScaleColumn(svd->V,nv,1.0/lastbeta);CHKERRQ(ierr);
/* compute SVD of general matrix */
ierr = DSSetDimensions(svd->ds,nv,nv,svd->nconv,svd->nconv+l);CHKERRQ(ierr);
if (l==0) {
ierr = DSSetState(svd->ds,DS_STATE_INTERMEDIATE);CHKERRQ(ierr);
} else {
ierr = DSSetState(svd->ds,DS_STATE_RAW);CHKERRQ(ierr);
}
ierr = DSSolve(svd->ds,w,NULL);CHKERRQ(ierr);
ierr = DSSort(svd->ds,w,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
/* compute error estimates */
k = 0;
conv = PETSC_TRUE;
ierr = DSGetArray(svd->ds,DS_MAT_U,&Q);CHKERRQ(ierr);
ierr = DSGetArrayReal(svd->ds,DS_MAT_T,&alpha);CHKERRQ(ierr);
beta = alpha + ld;
for (i=svd->nconv;i<nv;i++) {
svd->sigma[i] = PetscRealPart(w[i]);
beta[i] = PetscRealPart(Q[nv-1+i*ld])*lastbeta;
svd->errest[i] = PetscAbsScalar(beta[i]);
if (svd->sigma[i] > svd->tol) svd->errest[i] /= svd->sigma[i];
if (conv) {
if (svd->errest[i] < svd->tol) k++;
else conv = PETSC_FALSE;
}
}
ierr = DSRestoreArrayReal(svd->ds,DS_MAT_T,&alpha);CHKERRQ(ierr);
ierr = DSRestoreArray(svd->ds,DS_MAT_U,&Q);CHKERRQ(ierr);
/* check convergence and update l */
if (svd->its >= svd->max_it) svd->reason = SVD_DIVERGED_ITS;
if (svd->nconv+k >= svd->nsv) svd->reason = SVD_CONVERGED_TOL;
if (svd->reason != SVD_CONVERGED_ITERATING) l = 0;
else l = PetscMax((nv-svd->nconv-k)/2,0);
/* compute converged singular vectors and restart vectors */
ierr = DSGetMat(svd->ds,DS_MAT_VT,&VT);CHKERRQ(ierr);
ierr = BVMultInPlaceTranspose(svd->V,VT,svd->nconv,svd->nconv+k+l);CHKERRQ(ierr);
ierr = MatDestroy(&VT);CHKERRQ(ierr);
ierr = DSGetMat(svd->ds,DS_MAT_U,&U);CHKERRQ(ierr);
ierr = BVMultInPlace(svd->U,U,svd->nconv,svd->nconv+k+l);CHKERRQ(ierr);
ierr = MatDestroy(&U);CHKERRQ(ierr);
/* copy the last vector to be the next initial vector */
if (svd->reason == SVD_CONVERGED_ITERATING) {
ierr = BVCopyColumn(svd->V,nv,svd->nconv+k+l);CHKERRQ(ierr);
}
svd->nconv += k;
ierr = SVDMonitor(svd,svd->its,svd->nconv,svd->sigma,svd->errest,nv);CHKERRQ(ierr);
}
/* orthonormalize U columns in one side method */
if (lanczos->oneside) {
for (i=0;i<svd->nconv;i++) {
ierr = BVOrthogonalizeColumn(svd->U,i,NULL,&norm,NULL);CHKERRQ(ierr);
ierr = BVScaleColumn(svd->U,i,1.0/norm);CHKERRQ(ierr);
}
}
/* free working space */
ierr = PetscFree(w);CHKERRQ(ierr);
if (swork) { ierr = PetscFree(swork);CHKERRQ(ierr); }
PetscFunctionReturn(0);
}
