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; }
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 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); }