/*@
STComputeExplicitOperator - Computes the explicit operator associated
to the eigenvalue problem with the specified spectral transformation.
Collective on ST
Input Parameter:
. st - the spectral transform context
Output Parameter:
. mat - the explicit operator
Notes:
This routine builds a matrix containing the explicit operator. For
example, in generalized problems with shift-and-invert spectral
transformation the result would be matrix (A - s B)^-1 B.
This computation is done by applying the operator to columns of the
identity matrix. This is analogous to MatComputeExplicitOperator().
Level: advanced
.seealso: STApply()
@*/
PetscErrorCode STComputeExplicitOperator(ST st,Mat *mat)
{
PetscErrorCode ierr;
Vec in,out;
PetscInt i,M,m,*rows,start,end;
const PetscScalar *array;
PetscScalar one = 1.0;
PetscMPIInt size;
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_CLASSID,1);
PetscValidPointer(mat,2);
STCheckMatrices(st,1);
if (st->nmat>2) SETERRQ(PetscObjectComm((PetscObject)st),PETSC_ERR_ARG_WRONGSTATE,"Can only be used with 1 or 2 matrices");
ierr = MPI_Comm_size(PetscObjectComm((PetscObject)st),&size);CHKERRQ(ierr);
ierr = MatGetVecs(st->A[0],&in,&out);CHKERRQ(ierr);
ierr = VecGetSize(out,&M);CHKERRQ(ierr);
ierr = VecGetLocalSize(out,&m);CHKERRQ(ierr);
ierr = VecSetOption(in,VEC_IGNORE_OFF_PROC_ENTRIES,PETSC_TRUE);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(out,&start,&end);CHKERRQ(ierr);
ierr = PetscMalloc1(m,&rows);CHKERRQ(ierr);
for (i=0;i<m;i++) rows[i] = start + i;
ierr = MatCreate(PetscObjectComm((PetscObject)st),mat);CHKERRQ(ierr);
ierr = MatSetSizes(*mat,m,m,M,M);CHKERRQ(ierr);
if (size == 1) {
ierr = MatSetType(*mat,MATSEQDENSE);CHKERRQ(ierr);
ierr = MatSeqDenseSetPreallocation(*mat,NULL);CHKERRQ(ierr);
} else {
ierr = MatSetType(*mat,MATMPIAIJ);CHKERRQ(ierr);
ierr = MatMPIAIJSetPreallocation(*mat,m,NULL,M-m,NULL);CHKERRQ(ierr);
}
for (i=0;i<M;i++) {
ierr = VecSet(in,0.0);CHKERRQ(ierr);
ierr = VecSetValues(in,1,&i,&one,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecAssemblyBegin(in);CHKERRQ(ierr);
ierr = VecAssemblyEnd(in);CHKERRQ(ierr);
ierr = STApply(st,in,out);CHKERRQ(ierr);
ierr = VecGetArrayRead(out,&array);CHKERRQ(ierr);
ierr = MatSetValues(*mat,m,rows,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(out,&array);CHKERRQ(ierr);
}
ierr = PetscFree(rows);CHKERRQ(ierr);
ierr = VecDestroy(&in);CHKERRQ(ierr);
ierr = VecDestroy(&out);CHKERRQ(ierr);
ierr = MatAssemblyBegin(*mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(*mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
EPSDelayedArnoldi1 - This function is similar to EPSDelayedArnoldi,
but without reorthogonalization (only delayed normalization).
*/
PetscErrorCode EPSDelayedArnoldi1(EPS eps,PetscScalar *H,PetscInt ldh,Vec *V,PetscInt k,PetscInt *M,Vec f,PetscReal *beta,PetscBool *breakdown)
{
PetscErrorCode ierr;
PetscInt i,j,m=*M;
PetscScalar dot;
PetscReal norm=0.0;
PetscFunctionBegin;
for (j=k;j<m;j++) {
ierr = STApply(eps->st,V[j],f);CHKERRQ(ierr);
ierr = IPOrthogonalize(eps->ip,0,NULL,eps->nds,NULL,eps->defl,f,NULL,NULL,NULL);CHKERRQ(ierr);
ierr = IPMInnerProductBegin(eps->ip,f,j+1,V,H+ldh*j);CHKERRQ(ierr);
if (j>k) {
ierr = IPInnerProductBegin(eps->ip,V[j],V[j],&dot);CHKERRQ(ierr);
}
ierr = IPMInnerProductEnd(eps->ip,f,j+1,V,H+ldh*j);CHKERRQ(ierr);
if (j>k) {
ierr = IPInnerProductEnd(eps->ip,V[j],V[j],&dot);CHKERRQ(ierr);
}
if (j>k) {
norm = PetscSqrtReal(PetscRealPart(dot));
ierr = VecScale(V[j],1.0/norm);CHKERRQ(ierr);
H[ldh*(j-1)+j] = norm;
for (i=0;i<j;i++)
H[ldh*j+i] = H[ldh*j+i]/norm;
H[ldh*j+j] = H[ldh*j+j]/dot;
ierr = VecScale(f,1.0/norm);CHKERRQ(ierr);
}
ierr = SlepcVecMAXPBY(f,1.0,-1.0,j+1,H+ldh*j,V);CHKERRQ(ierr);
if (j<m-1) {
ierr = VecCopy(f,V[j+1]);CHKERRQ(ierr);
}
}
ierr = IPNorm(eps->ip,f,beta);CHKERRQ(ierr);
ierr = VecScale(f,1.0 / *beta);CHKERRQ(ierr);
*breakdown = PETSC_FALSE;
PetscFunctionReturn(0);
}
/*
EPSLocalLanczos - Local reorthogonalization.
This is the simplest variant. At each Lanczos step, the corresponding Lanczos vector
is orthogonalized with respect to the two previous Lanczos vectors, according to
the three term Lanczos recurrence. WARNING: This variant does not track the loss of
orthogonality that occurs in finite-precision arithmetic and, therefore, the
generated vectors are not guaranteed to be (semi-)orthogonal.
*/
static PetscErrorCode EPSLocalLanczos(EPS eps,PetscReal *alpha,PetscReal *beta,PetscInt k,PetscInt *M,PetscBool *breakdown)
{
PetscErrorCode ierr;
PetscInt i,j,m = *M;
Vec vj,vj1;
PetscBool *which,lwhich[100];
PetscScalar *hwork,lhwork[100];
PetscFunctionBegin;
if (m > 100) {
ierr = PetscMalloc2(m,&which,m,&hwork);CHKERRQ(ierr);
} else {
which = lwhich;
hwork = lhwork;
}
for (i=0;i<k;i++) which[i] = PETSC_TRUE;
ierr = BVSetActiveColumns(eps->V,0,m);CHKERRQ(ierr);
for (j=k;j<m;j++) {
ierr = BVGetColumn(eps->V,j,&vj);CHKERRQ(ierr);
ierr = BVGetColumn(eps->V,j+1,&vj1);CHKERRQ(ierr);
ierr = STApply(eps->st,vj,vj1);CHKERRQ(ierr);
ierr = BVRestoreColumn(eps->V,j,&vj);CHKERRQ(ierr);
ierr = BVRestoreColumn(eps->V,j+1,&vj1);CHKERRQ(ierr);
which[j] = PETSC_TRUE;
if (j-2>=k) which[j-2] = PETSC_FALSE;
ierr = BVOrthogonalizeSomeColumn(eps->V,j+1,which,hwork,beta+j,breakdown);CHKERRQ(ierr);
alpha[j] = PetscRealPart(hwork[j]);
if (*breakdown) {
*M = j+1;
break;
} else {
ierr = BVScaleColumn(eps->V,j+1,1/beta[j]);CHKERRQ(ierr);
}
}
if (m > 100) {
ierr = PetscFree2(which,hwork);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*
EPSGetStartVector - Generate a suitable vector to be used as the starting vector
for the recurrence that builds the right subspace.
Collective on EPS and Vec
Input Parameters:
+ eps - the eigensolver context
- i - iteration number
Output Parameters:
. breakdown - flag indicating that a breakdown has occurred
Notes:
The start vector is computed from another vector: for the first step (i=0),
the first initial vector is used (see EPSSetInitialSpace()); otherwise a random
vector is created. Then this vector is forced to be in the range of OP (only
for generalized definite problems) and orthonormalized with respect to all
V-vectors up to i-1. The resulting vector is placed in V[i].
The flag breakdown is set to true if either i=0 and the vector belongs to the
deflation space, or i>0 and the vector is linearly dependent with respect
to the V-vectors.
*/
PetscErrorCode EPSGetStartVector(EPS eps,PetscInt i,PetscBool *breakdown)
{
PetscErrorCode ierr;
PetscReal norm;
PetscBool lindep;
Vec w,z;
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_CLASSID,1);
PetscValidLogicalCollectiveInt(eps,i,2);
/* For the first step, use the first initial vector, otherwise a random one */
if (i>0 || eps->nini==0) {
ierr = BVSetRandomColumn(eps->V,i,eps->rand);CHKERRQ(ierr);
}
ierr = BVGetVec(eps->V,&w);CHKERRQ(ierr);
ierr = BVCopyVec(eps->V,i,w);CHKERRQ(ierr);
/* Force the vector to be in the range of OP for definite generalized problems */
ierr = BVGetColumn(eps->V,i,&z);CHKERRQ(ierr);
if (eps->ispositive || (eps->isgeneralized && eps->ishermitian)) {
ierr = STApply(eps->st,w,z);CHKERRQ(ierr);
} else {
ierr = VecCopy(w,z);CHKERRQ(ierr);
}
ierr = BVRestoreColumn(eps->V,i,&z);CHKERRQ(ierr);
ierr = VecDestroy(&w);CHKERRQ(ierr);
/* Orthonormalize the vector with respect to previous vectors */
ierr = BVOrthogonalizeColumn(eps->V,i,NULL,&norm,&lindep);CHKERRQ(ierr);
if (breakdown) *breakdown = lindep;
else if (lindep || norm == 0.0) {
if (i==0) SETERRQ(PetscObjectComm((PetscObject)eps),1,"Initial vector is zero or belongs to the deflation space");
else SETERRQ(PetscObjectComm((PetscObject)eps),1,"Unable to generate more start vectors");
}
ierr = BVScaleColumn(eps->V,i,1.0/norm);CHKERRQ(ierr);
PetscFunctionReturn(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);
}
/*
EPSPartialLanczos - Partial reorthogonalization.
*/
static PetscErrorCode EPSPartialLanczos(EPS eps,PetscReal *alpha,PetscReal *beta,PetscInt k,PetscInt *M,PetscBool *breakdown,PetscReal anorm)
{
PetscErrorCode ierr;
EPS_LANCZOS *lanczos = (EPS_LANCZOS*)eps->data;
PetscInt i,j,m = *M;
Vec vj,vj1;
PetscReal norm,*omega,lomega[100],*omega_old,lomega_old[100],eps1,delta,eta;
PetscBool *which,lwhich[100],*which2,lwhich2[100];
PetscBool reorth = PETSC_FALSE,force_reorth = PETSC_FALSE;
PetscBool fro = PETSC_FALSE,estimate_anorm = PETSC_FALSE;
PetscScalar *hwork,lhwork[100];
PetscFunctionBegin;
if (m>100) {
ierr = PetscMalloc5(m,&omega,m,&omega_old,m,&which,m,&which2,m,&hwork);CHKERRQ(ierr);
} else {
omega = lomega;
omega_old = lomega_old;
which = lwhich;
which2 = lwhich2;
hwork = lhwork;
}
eps1 = PetscSqrtReal((PetscReal)eps->n)*PETSC_MACHINE_EPSILON/2;
delta = PETSC_SQRT_MACHINE_EPSILON/PetscSqrtReal((PetscReal)eps->ncv);
eta = PetscPowReal(PETSC_MACHINE_EPSILON,3.0/4.0)/PetscSqrtReal((PetscReal)eps->ncv);
if (anorm < 0.0) {
anorm = 1.0;
estimate_anorm = PETSC_TRUE;
}
for (i=0;i<m-k;i++) omega[i] = omega_old[i] = 0.0;
for (i=0;i<k;i++) which[i] = PETSC_TRUE;
ierr = BVSetActiveColumns(eps->V,0,m);CHKERRQ(ierr);
for (j=k;j<m;j++) {
ierr = BVGetColumn(eps->V,j,&vj);CHKERRQ(ierr);
ierr = BVGetColumn(eps->V,j+1,&vj1);CHKERRQ(ierr);
ierr = STApply(eps->st,vj,vj1);CHKERRQ(ierr);
ierr = BVRestoreColumn(eps->V,j,&vj);CHKERRQ(ierr);
ierr = BVRestoreColumn(eps->V,j+1,&vj1);CHKERRQ(ierr);
if (fro) {
/* Lanczos step with full reorthogonalization */
ierr = BVOrthogonalizeColumn(eps->V,j+1,hwork,&norm,breakdown);CHKERRQ(ierr);
alpha[j] = PetscRealPart(hwork[j]);
} else {
/* Lanczos step */
which[j] = PETSC_TRUE;
if (j-2>=k) which[j-2] = PETSC_FALSE;
ierr = BVOrthogonalizeSomeColumn(eps->V,j+1,which,hwork,&norm,breakdown);CHKERRQ(ierr);
alpha[j] = PetscRealPart(hwork[j]);
beta[j] = norm;
/* Estimate ||A|| if needed */
if (estimate_anorm) {
if (j>k) anorm = PetscMax(anorm,PetscAbsReal(alpha[j])+norm+beta[j-1]);
else anorm = PetscMax(anorm,PetscAbsReal(alpha[j])+norm);
}
/* Check if reorthogonalization is needed */
reorth = PETSC_FALSE;
if (j>k) {
update_omega(omega,omega_old,j,alpha,beta-1,eps1,anorm);
for (i=0;i<j-k;i++) {
if (PetscAbsScalar(omega[i]) > delta) reorth = PETSC_TRUE;
}
}
if (reorth || force_reorth) {
for (i=0;i<k;i++) which2[i] = PETSC_FALSE;
for (i=k;i<=j;i++) which2[i] = PETSC_TRUE;
if (lanczos->reorthog == EPS_LANCZOS_REORTHOG_PERIODIC) {
/* Periodic reorthogonalization */
if (force_reorth) force_reorth = PETSC_FALSE;
else force_reorth = PETSC_TRUE;
for (i=0;i<j-k;i++) omega[i] = eps1;
} else {
/* Partial reorthogonalization */
if (force_reorth) force_reorth = PETSC_FALSE;
else {
force_reorth = PETSC_TRUE;
compute_int(which2+k,omega,j-k,delta,eta);
for (i=0;i<j-k;i++) {
if (which2[i+k]) omega[i] = eps1;
}
}
}
ierr = BVOrthogonalizeSomeColumn(eps->V,j+1,which2,hwork,&norm,breakdown);CHKERRQ(ierr);
}
}
if (*breakdown || norm < eps->n*anorm*PETSC_MACHINE_EPSILON) {
*M = j+1;
break;
}
if (!fro && norm*delta < anorm*eps1) {
fro = PETSC_TRUE;
ierr = PetscInfo1(eps,"Switching to full reorthogonalization at iteration %D\n",eps->its);CHKERRQ(ierr);
}
beta[j] = norm;
ierr = BVScaleColumn(eps->V,j+1,1.0/norm);CHKERRQ(ierr);
}
if (m>100) {
ierr = PetscFree5(omega,omega_old,which,which2,hwork);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*
EPSSelectiveLanczos - Selective reorthogonalization.
*/
static PetscErrorCode EPSSelectiveLanczos(EPS eps,PetscReal *alpha,PetscReal *beta,PetscInt k,PetscInt *M,PetscBool *breakdown,PetscReal anorm)
{
PetscErrorCode ierr;
EPS_LANCZOS *lanczos = (EPS_LANCZOS*)eps->data;
PetscInt i,j,m = *M,n,nritz=0,nritzo;
Vec vj,vj1,av;
PetscReal *d,*e,*ritz,norm;
PetscScalar *Y,*hwork;
PetscBool *which;
PetscFunctionBegin;
ierr = PetscCalloc6(m+1,&d,m,&e,m,&ritz,m*m,&Y,m,&which,m,&hwork);CHKERRQ(ierr);
for (i=0;i<k;i++) which[i] = PETSC_TRUE;
for (j=k;j<m;j++) {
ierr = BVSetActiveColumns(eps->V,0,m);CHKERRQ(ierr);
/* Lanczos step */
ierr = BVGetColumn(eps->V,j,&vj);CHKERRQ(ierr);
ierr = BVGetColumn(eps->V,j+1,&vj1);CHKERRQ(ierr);
ierr = STApply(eps->st,vj,vj1);CHKERRQ(ierr);
ierr = BVRestoreColumn(eps->V,j,&vj);CHKERRQ(ierr);
ierr = BVRestoreColumn(eps->V,j+1,&vj1);CHKERRQ(ierr);
which[j] = PETSC_TRUE;
if (j-2>=k) which[j-2] = PETSC_FALSE;
ierr = BVOrthogonalizeSomeColumn(eps->V,j+1,which,hwork,&norm,breakdown);CHKERRQ(ierr);
alpha[j] = PetscRealPart(hwork[j]);
beta[j] = norm;
if (*breakdown) {
*M = j+1;
break;
}
/* Compute eigenvalues and eigenvectors Y of the tridiagonal block */
n = j-k+1;
for (i=0;i<n;i++) {
d[i] = alpha[i+k];
e[i] = beta[i+k];
}
ierr = DenseTridiagonal(n,d,e,ritz,Y);CHKERRQ(ierr);
/* Estimate ||A|| */
for (i=0;i<n;i++)
if (PetscAbsReal(ritz[i]) > anorm) anorm = PetscAbsReal(ritz[i]);
/* Compute nearly converged Ritz vectors */
nritzo = 0;
for (i=0;i<n;i++) {
if (norm*PetscAbsScalar(Y[i*n+n-1]) < PETSC_SQRT_MACHINE_EPSILON*anorm) nritzo++;
}
if (nritzo>nritz) {
nritz = 0;
for (i=0;i<n;i++) {
if (norm*PetscAbsScalar(Y[i*n+n-1]) < PETSC_SQRT_MACHINE_EPSILON*anorm) {
ierr = BVSetActiveColumns(eps->V,k,k+n);CHKERRQ(ierr);
ierr = BVGetColumn(lanczos->AV,nritz,&av);CHKERRQ(ierr);
ierr = BVMultVec(eps->V,1.0,0.0,av,Y+i*n);CHKERRQ(ierr);
ierr = BVRestoreColumn(lanczos->AV,nritz,&av);CHKERRQ(ierr);
nritz++;
}
}
}
if (nritz > 0) {
ierr = BVGetColumn(eps->V,j+1,&vj1);CHKERRQ(ierr);
ierr = BVSetActiveColumns(lanczos->AV,0,nritz);CHKERRQ(ierr);
ierr = BVOrthogonalizeVec(lanczos->AV,vj1,hwork,&norm,breakdown);CHKERRQ(ierr);
ierr = BVRestoreColumn(eps->V,j+1,&vj1);CHKERRQ(ierr);
if (*breakdown) {
*M = j+1;
break;
}
}
ierr = BVScaleColumn(eps->V,j+1,1.0/norm);CHKERRQ(ierr);
}
ierr = PetscFree6(d,e,ritz,Y,which,hwork);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
EPSDelayedArnoldi - This function is equivalent to EPSBasicArnoldi but
performs the computation in a different way. The main idea is that
reorthogonalization is delayed to the next Arnoldi step. This version is
more scalable but in some cases convergence may stagnate.
*/
PetscErrorCode EPSDelayedArnoldi(EPS eps,PetscScalar *H,PetscInt ldh,Vec *V,PetscInt k,PetscInt *M,Vec f,PetscReal *beta,PetscBool *breakdown)
{
PetscErrorCode ierr;
PetscInt i,j,m=*M;
Vec u,t;
PetscScalar shh[100],*lhh,dot,dot2;
PetscReal norm1=0.0,norm2;
PetscFunctionBegin;
if (m<=100) lhh = shh;
else {
ierr = PetscMalloc1(m,&lhh);CHKERRQ(ierr);
}
ierr = VecDuplicate(f,&u);CHKERRQ(ierr);
ierr = VecDuplicate(f,&t);CHKERRQ(ierr);
for (j=k;j<m;j++) {
ierr = STApply(eps->st,V[j],f);CHKERRQ(ierr);
ierr = IPOrthogonalize(eps->ip,0,NULL,eps->nds,NULL,eps->defl,f,NULL,NULL,NULL);CHKERRQ(ierr);
ierr = IPMInnerProductBegin(eps->ip,f,j+1,V,H+ldh*j);CHKERRQ(ierr);
if (j>k) {
ierr = IPMInnerProductBegin(eps->ip,V[j],j,V,lhh);CHKERRQ(ierr);
ierr = IPInnerProductBegin(eps->ip,V[j],V[j],&dot);CHKERRQ(ierr);
}
if (j>k+1) {
ierr = IPNormBegin(eps->ip,u,&norm2);CHKERRQ(ierr);
ierr = VecDotBegin(u,V[j-2],&dot2);CHKERRQ(ierr);
}
ierr = IPMInnerProductEnd(eps->ip,f,j+1,V,H+ldh*j);CHKERRQ(ierr);
if (j>k) {
ierr = IPMInnerProductEnd(eps->ip,V[j],j,V,lhh);CHKERRQ(ierr);
ierr = IPInnerProductEnd(eps->ip,V[j],V[j],&dot);CHKERRQ(ierr);
}
if (j>k+1) {
ierr = IPNormEnd(eps->ip,u,&norm2);CHKERRQ(ierr);
ierr = VecDotEnd(u,V[j-2],&dot2);CHKERRQ(ierr);
if (PetscAbsScalar(dot2/norm2) > PETSC_MACHINE_EPSILON) {
*breakdown = PETSC_TRUE;
*M = j-1;
*beta = norm2;
if (m>100) { ierr = PetscFree(lhh);CHKERRQ(ierr); }
ierr = VecDestroy(&u);CHKERRQ(ierr);
ierr = VecDestroy(&t);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
}
if (j>k) {
norm1 = PetscSqrtReal(PetscRealPart(dot));
for (i=0;i<j;i++)
H[ldh*j+i] = H[ldh*j+i]/norm1;
H[ldh*j+j] = H[ldh*j+j]/dot;
ierr = VecCopy(V[j],t);CHKERRQ(ierr);
ierr = VecScale(V[j],1.0/norm1);CHKERRQ(ierr);
ierr = VecScale(f,1.0/norm1);CHKERRQ(ierr);
}
ierr = SlepcVecMAXPBY(f,1.0,-1.0,j+1,H+ldh*j,V);CHKERRQ(ierr);
if (j>k) {
ierr = SlepcVecMAXPBY(t,1.0,-1.0,j,lhh,V);CHKERRQ(ierr);
for (i=0;i<j;i++)
H[ldh*(j-1)+i] += lhh[i];
}
if (j>k+1) {
ierr = VecCopy(u,V[j-1]);CHKERRQ(ierr);
ierr = VecScale(V[j-1],1.0/norm2);CHKERRQ(ierr);
H[ldh*(j-2)+j-1] = norm2;
}
if (j<m-1) {
ierr = VecCopy(f,V[j+1]);CHKERRQ(ierr);
ierr = VecCopy(t,u);CHKERRQ(ierr);
}
}
ierr = IPNorm(eps->ip,t,&norm2);CHKERRQ(ierr);
ierr = VecScale(t,1.0/norm2);CHKERRQ(ierr);
ierr = VecCopy(t,V[m-1]);CHKERRQ(ierr);
H[ldh*(m-2)+m-1] = norm2;
ierr = IPMInnerProduct(eps->ip,f,m,V,lhh);CHKERRQ(ierr);
ierr = SlepcVecMAXPBY(f,1.0,-1.0,m,lhh,V);CHKERRQ(ierr);
for (i=0;i<m;i++)
H[ldh*(m-1)+i] += lhh[i];
ierr = IPNorm(eps->ip,f,beta);CHKERRQ(ierr);
ierr = VecScale(f,1.0 / *beta);CHKERRQ(ierr);
*breakdown = PETSC_FALSE;
if (m>100) { ierr = PetscFree(lhh);CHKERRQ(ierr); }
ierr = VecDestroy(&u);CHKERRQ(ierr);
ierr = VecDestroy(&t);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
Mat A,B,M,mat[2];
ST st;
Vec v,w;
STType type;
PetscScalar value[3],sigma,tau;
PetscInt n=10,i,Istart,Iend,col[3];
PetscBool FirstBlock=PETSC_FALSE,LastBlock=PETSC_FALSE;
PetscErrorCode ierr;
SlepcInitialize(&argc,&argv,(char*)0,help);
ierr = PetscOptionsGetInt(NULL,"-n",&n,NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n1-D Laplacian plus diagonal, n=%D\n\n",n);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Compute the operator matrix for the 1-D Laplacian
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&B);CHKERRQ(ierr);
ierr = MatSetSizes(B,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(B);CHKERRQ(ierr);
ierr = MatSetUp(B);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(A,&Istart,&Iend);CHKERRQ(ierr);
if (Istart==0) FirstBlock=PETSC_TRUE;
if (Iend==n) LastBlock=PETSC_TRUE;
value[0]=-1.0; value[1]=2.0; value[2]=-1.0;
for (i=(FirstBlock? Istart+1: Istart); i<(LastBlock? Iend-1: Iend); i++) {
col[0]=i-1; col[1]=i; col[2]=i+1;
ierr = MatSetValues(A,1,&i,3,col,value,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValue(B,i,i,(PetscScalar)i,INSERT_VALUES);CHKERRQ(ierr);
}
if (LastBlock) {
i=n-1; col[0]=n-2; col[1]=n-1;
ierr = MatSetValues(A,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValue(B,i,i,(PetscScalar)i,INSERT_VALUES);CHKERRQ(ierr);
}
if (FirstBlock) {
i=0; col[0]=0; col[1]=1; value[0]=2.0; value[1]=-1.0;
ierr = MatSetValues(A,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValue(B,i,i,-1.0,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatGetVecs(A,&v,&w);CHKERRQ(ierr);
ierr = VecSet(v,1.0);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the spectral transformation object
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = STCreate(PETSC_COMM_WORLD,&st);CHKERRQ(ierr);
mat[0] = A;
mat[1] = B;
ierr = STSetOperators(st,2,mat);CHKERRQ(ierr);
ierr = STSetFromOptions(st);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Apply the transformed operator for several ST's
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* shift, sigma=0.0 */
ierr = STSetUp(st);CHKERRQ(ierr);
ierr = STGetType(st,&type);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"ST type %s\n",type);CHKERRQ(ierr);
ierr = STApply(st,v,w);CHKERRQ(ierr);
ierr = VecView(w,NULL);CHKERRQ(ierr);
/* shift, sigma=0.1 */
sigma = 0.1;
ierr = STSetShift(st,sigma);CHKERRQ(ierr);
ierr = STGetShift(st,&sigma);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"With shift=%g\n",(double)PetscRealPart(sigma));CHKERRQ(ierr);
ierr = STApply(st,v,w);CHKERRQ(ierr);
ierr = VecView(w,NULL);CHKERRQ(ierr);
/* sinvert, sigma=0.1 */
ierr = STPostSolve(st);CHKERRQ(ierr); /* undo changes if inplace */
ierr = STSetType(st,STSINVERT);CHKERRQ(ierr);
ierr = STGetType(st,&type);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"ST type %s\n",type);CHKERRQ(ierr);
ierr = STGetShift(st,&sigma);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"With shift=%g\n",(double)PetscRealPart(sigma));CHKERRQ(ierr);
ierr = STApply(st,v,w);CHKERRQ(ierr);
ierr = VecView(w,NULL);CHKERRQ(ierr);
/* sinvert, sigma=-0.5 */
sigma = -0.5;
ierr = STSetShift(st,sigma);CHKERRQ(ierr);
ierr = STGetShift(st,&sigma);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"With shift=%g\n",(double)PetscRealPart(sigma));CHKERRQ(ierr);
ierr = STApply(st,v,w);CHKERRQ(ierr);
ierr = VecView(w,NULL);CHKERRQ(ierr);
/* cayley, sigma=-0.5, tau=-0.5 (equal to sigma by default) */
ierr = STPostSolve(st);CHKERRQ(ierr); /* undo changes if inplace */
ierr = STSetType(st,STCAYLEY);CHKERRQ(ierr);
ierr = STSetUp(st);CHKERRQ(ierr);
ierr = STGetType(st,&type);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"ST type %s\n",type);CHKERRQ(ierr);
ierr = STGetShift(st,&sigma);CHKERRQ(ierr);
ierr = STCayleyGetAntishift(st,&tau);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"With shift=%g, antishift=%g\n",(double)PetscRealPart(sigma),(double)PetscRealPart(tau));CHKERRQ(ierr);
ierr = STApply(st,v,w);CHKERRQ(ierr);
ierr = VecView(w,NULL);CHKERRQ(ierr);
/* cayley, sigma=1.1, tau=1.1 (still equal to sigma) */
sigma = 1.1;
ierr = STSetShift(st,sigma);CHKERRQ(ierr);
ierr = STGetShift(st,&sigma);CHKERRQ(ierr);
ierr = STCayleyGetAntishift(st,&tau);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"With shift=%g, antishift=%g\n",(double)PetscRealPart(sigma),(double)PetscRealPart(tau));CHKERRQ(ierr);
ierr = STApply(st,v,w);CHKERRQ(ierr);
ierr = VecView(w,NULL);CHKERRQ(ierr);
/* cayley, sigma=1.1, tau=-1.0 */
tau = -1.0;
ierr = STCayleySetAntishift(st,tau);CHKERRQ(ierr);
ierr = STGetShift(st,&sigma);CHKERRQ(ierr);
ierr = STCayleyGetAntishift(st,&tau);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"With shift=%g, antishift=%g\n",(double)PetscRealPart(sigma),(double)PetscRealPart(tau));CHKERRQ(ierr);
ierr = STApply(st,v,w);CHKERRQ(ierr);
ierr = VecView(w,NULL);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Check inner product matrix in Cayley
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = STGetBilinearForm(st,&M);CHKERRQ(ierr);
ierr = MatMult(M,v,w);CHKERRQ(ierr);
ierr = VecView(w,NULL);CHKERRQ(ierr);
ierr = STDestroy(&st);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = MatDestroy(&B);CHKERRQ(ierr);
ierr = MatDestroy(&M);CHKERRQ(ierr);
ierr = VecDestroy(&v);CHKERRQ(ierr);
ierr = VecDestroy(&w);CHKERRQ(ierr);
ierr = SlepcFinalize();
return 0;
}