/*
PEPLinearExtract_Norm - Auxiliary routine that copies the solution of the
linear eigenproblem to the PEP object. The eigenvector of the generalized
problem is supposed to be
z = [ x ]
[ l*x ]
If |l|<1.0, the eigenvector is taken from z(1:n), otherwise from z(n+1:2*n).
Finally, x is normalized so that ||x||_2 = 1.
*/
static PetscErrorCode PEPLinearExtract_Norm(PEP pep,EPS eps)
{
PetscErrorCode ierr;
PetscInt i,offset;
PetscScalar *px;
Vec xr,xi,w,vi;
#if !defined(PETSC_USE_COMPLEX)
Vec vi1;
#endif
Mat A;
PetscFunctionBegin;
ierr = EPSGetOperators(eps,&A,NULL);CHKERRQ(ierr);
ierr = MatGetVecs(A,&xr,NULL);CHKERRQ(ierr);
ierr = VecDuplicate(xr,&xi);CHKERRQ(ierr);
ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)pep),1,pep->nloc,pep->n,NULL,&w);CHKERRQ(ierr);
for (i=0;i<pep->nconv;i++) {
ierr = EPSGetEigenpair(eps,i,&pep->eigr[i],&pep->eigi[i],xr,xi);CHKERRQ(ierr);
pep->eigr[i] *= pep->sfactor;
pep->eigi[i] *= pep->sfactor;
if (SlepcAbsEigenvalue(pep->eigr[i],pep->eigi[i])>1.0) offset = pep->nloc;
else offset = 0;
#if !defined(PETSC_USE_COMPLEX)
if (pep->eigi[i]>0.0) { /* first eigenvalue of a complex conjugate pair */
ierr = VecGetArray(xr,&px);CHKERRQ(ierr);
ierr = VecPlaceArray(w,px+offset);CHKERRQ(ierr);
ierr = BVInsertVec(pep->V,i,w);CHKERRQ(ierr);
ierr = VecResetArray(w);CHKERRQ(ierr);
ierr = VecRestoreArray(xr,&px);CHKERRQ(ierr);
ierr = VecGetArray(xi,&px);CHKERRQ(ierr);
ierr = VecPlaceArray(w,px+offset);CHKERRQ(ierr);
ierr = BVInsertVec(pep->V,i+1,w);CHKERRQ(ierr);
ierr = VecResetArray(w);CHKERRQ(ierr);
ierr = VecRestoreArray(xi,&px);CHKERRQ(ierr);
ierr = BVGetColumn(pep->V,i,&vi);CHKERRQ(ierr);
ierr = BVGetColumn(pep->V,i+1,&vi1);CHKERRQ(ierr);
ierr = SlepcVecNormalize(vi,vi1,PETSC_TRUE,NULL);CHKERRQ(ierr);
ierr = BVRestoreColumn(pep->V,i,&vi);CHKERRQ(ierr);
ierr = BVRestoreColumn(pep->V,i+1,&vi1);CHKERRQ(ierr);
} else if (pep->eigi[i]==0.0) /* real eigenvalue */
#endif
{
ierr = VecGetArray(xr,&px);CHKERRQ(ierr);
ierr = VecPlaceArray(w,px+offset);CHKERRQ(ierr);
ierr = BVInsertVec(pep->V,i,w);CHKERRQ(ierr);
ierr = VecResetArray(w);CHKERRQ(ierr);
ierr = VecRestoreArray(xr,&px);CHKERRQ(ierr);
ierr = BVGetColumn(pep->V,i,&vi);CHKERRQ(ierr);
ierr = SlepcVecNormalize(vi,NULL,PETSC_FALSE,NULL);CHKERRQ(ierr);
ierr = BVRestoreColumn(pep->V,i,&vi);CHKERRQ(ierr);
}
}
ierr = VecDestroy(&w);CHKERRQ(ierr);
ierr = VecDestroy(&xr);CHKERRQ(ierr);
ierr = VecDestroy(&xi);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode PEPComputeVectors_Schur(PEP pep)
{
PetscErrorCode ierr;
PetscInt n,i;
Mat Z;
Vec v;
#if !defined(PETSC_USE_COMPLEX)
Vec v1;
PetscScalar tmp;
PetscReal norm,normi;
#endif
PetscFunctionBegin;
ierr = DSGetDimensions(pep->ds,&n,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
ierr = DSVectors(pep->ds,DS_MAT_X,NULL,NULL);CHKERRQ(ierr);
ierr = DSGetMat(pep->ds,DS_MAT_X,&Z);CHKERRQ(ierr);
ierr = BVSetActiveColumns(pep->V,0,n);CHKERRQ(ierr);
ierr = BVMultInPlace(pep->V,Z,0,n);CHKERRQ(ierr);
ierr = MatDestroy(&Z);CHKERRQ(ierr);
/* Fix eigenvectors if balancing was used */
if ((pep->scale==PEP_SCALE_DIAGONAL || pep->scale==PEP_SCALE_BOTH) && pep->Dr && (pep->refine!=PEP_REFINE_MULTIPLE)) {
for (i=0;i<n;i++) {
ierr = BVGetColumn(pep->V,i,&v);CHKERRQ(ierr);
ierr = VecPointwiseMult(v,v,pep->Dr);CHKERRQ(ierr);
ierr = BVRestoreColumn(pep->V,i,&v);CHKERRQ(ierr);
}
}
/* normalization */
for (i=0;i<n;i++) {
#if !defined(PETSC_USE_COMPLEX)
if (pep->eigi[i] != 0.0) {
ierr = BVGetColumn(pep->V,i,&v);CHKERRQ(ierr);
ierr = BVGetColumn(pep->V,i+1,&v1);CHKERRQ(ierr);
ierr = VecNorm(v,NORM_2,&norm);CHKERRQ(ierr);
ierr = VecNorm(v1,NORM_2,&normi);CHKERRQ(ierr);
tmp = 1.0 / SlepcAbsEigenvalue(norm,normi);
ierr = VecScale(v,tmp);CHKERRQ(ierr);
ierr = VecScale(v1,tmp);CHKERRQ(ierr);
ierr = BVRestoreColumn(pep->V,i,&v);CHKERRQ(ierr);
ierr = BVRestoreColumn(pep->V,i+1,&v1);CHKERRQ(ierr);
i++;
} else
#endif
{
ierr = BVGetColumn(pep->V,i,&v);CHKERRQ(ierr);
ierr = VecNormalize(v,NULL);CHKERRQ(ierr);
ierr = BVRestoreColumn(pep->V,i,&v);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
static PetscErrorCode SVDOneSideTRLanczosMGS(SVD svd,PetscReal *alpha,PetscReal *beta,BV V,BV U,PetscInt nconv,PetscInt l,PetscInt n)
{
PetscErrorCode ierr;
PetscReal a,b;
PetscScalar gamma;
PetscInt i,k=nconv+l;
Vec ui,ui1,vi;
PetscFunctionBegin;
ierr = BVGetColumn(V,k,&vi);CHKERRQ(ierr);
ierr = BVGetColumn(U,k,&ui);CHKERRQ(ierr);
ierr = SVDMatMult(svd,PETSC_FALSE,vi,ui);CHKERRQ(ierr);
ierr = BVRestoreColumn(V,k,&vi);CHKERRQ(ierr);
ierr = BVRestoreColumn(U,k,&ui);CHKERRQ(ierr);
if (l>0) {
ierr = BVMultColumn(U,-1.0,1.0,k,&gamma);CHKERRQ(ierr);
beta[nconv] = PetscRealPart(gamma);
}
ierr = BVNormColumn(U,k,NORM_2,&a);CHKERRQ(ierr);
ierr = BVScaleColumn(U,k,1.0/a);CHKERRQ(ierr);
alpha[k] = a;
for (i=k+1;i<n;i++) {
ierr = BVGetColumn(V,i,&vi);CHKERRQ(ierr);
ierr = BVGetColumn(U,i-1,&ui1);CHKERRQ(ierr);
ierr = SVDMatMult(svd,PETSC_TRUE,ui1,vi);CHKERRQ(ierr);
ierr = BVRestoreColumn(V,i,&vi);CHKERRQ(ierr);
ierr = BVRestoreColumn(U,i-1,&ui1);CHKERRQ(ierr);
ierr = BVOrthogonalizeColumn(V,i,NULL,&b,NULL);CHKERRQ(ierr);
ierr = BVScaleColumn(V,i,1.0/b);CHKERRQ(ierr);
beta[i-1] = b;
ierr = BVGetColumn(V,i,&vi);CHKERRQ(ierr);
ierr = BVGetColumn(U,i,&ui);CHKERRQ(ierr);
ierr = SVDMatMult(svd,PETSC_FALSE,vi,ui);CHKERRQ(ierr);
ierr = BVRestoreColumn(V,i,&vi);CHKERRQ(ierr);
ierr = BVGetColumn(U,i-1,&ui1);CHKERRQ(ierr);
ierr = VecAXPY(ui,-b,ui1);CHKERRQ(ierr);
ierr = BVRestoreColumn(U,i-1,&ui1);CHKERRQ(ierr);
ierr = BVRestoreColumn(U,i,&ui);CHKERRQ(ierr);
ierr = BVNormColumn(U,i,NORM_2,&a);CHKERRQ(ierr);
ierr = BVScaleColumn(U,i,1.0/a);CHKERRQ(ierr);
alpha[i] = a;
}
ierr = BVGetColumn(V,n,&vi);CHKERRQ(ierr);
ierr = BVGetColumn(U,n-1,&ui1);CHKERRQ(ierr);
ierr = SVDMatMult(svd,PETSC_TRUE,ui1,vi);CHKERRQ(ierr);
ierr = BVRestoreColumn(V,n,&vi);CHKERRQ(ierr);
ierr = BVRestoreColumn(U,n-1,&ui1);CHKERRQ(ierr);
ierr = BVOrthogonalizeColumn(V,n,NULL,&b,NULL);CHKERRQ(ierr);
beta[n-1] = b;
PetscFunctionReturn(0);
}
static PetscErrorCode BVView_Default(BV bv,PetscViewer viewer)
{
PetscErrorCode ierr;
PetscInt j;
Vec v;
PetscViewerFormat format;
PetscBool isascii,ismatlab=PETSC_FALSE;
PetscFunctionBegin;
ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);CHKERRQ(ierr);
if (isascii) {
ierr = PetscViewerGetFormat(viewer,&format);CHKERRQ(ierr);
if (format == PETSC_VIEWER_ASCII_MATLAB) ismatlab = PETSC_TRUE;
}
if (ismatlab) {
ierr = PetscViewerASCIIPrintf(viewer,"%s=[];\n",((PetscObject)bv)->name);CHKERRQ(ierr);
}
for (j=bv->nc;j<bv->nc+bv->m;j++) {
ierr = BVGetColumn(bv,j,&v);CHKERRQ(ierr);
ierr = VecView(v,viewer);CHKERRQ(ierr);
if (ismatlab) {
ierr = PetscViewerASCIIPrintf(viewer,"%s=[%s,%s];clear %s\n",((PetscObject)bv)->name,((PetscObject)bv)->name,((PetscObject)v)->name,((PetscObject)v)->name);CHKERRQ(ierr);
}
ierr = BVRestoreColumn(bv,j,&v);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*
BVOrthogonalizeMGS1 - Compute one step of Modified Gram-Schmidt
*/
static PetscErrorCode BVOrthogonalizeMGS1(BV bv,PetscInt k,Vec v,PetscBool *which,PetscScalar *H)
{
PetscErrorCode ierr;
PetscInt i;
PetscScalar dot;
Vec vi,z;
PetscFunctionBegin;
z = v;
for (i=-bv->nc;i<k;i++) {
if (which && i>=0 && !which[i]) continue;
ierr = BVGetColumn(bv,i,&vi);CHKERRQ(ierr);
/* h_i = ( v, v_i ) */
if (bv->matrix) {
ierr = BV_IPMatMult(bv,v);CHKERRQ(ierr);
z = bv->Bx;
}
ierr = VecDot(z,vi,&dot);CHKERRQ(ierr);
/* v <- v - h_i v_i */
if (bv->indef) dot /= bv->omega[bv->nc+i];
ierr = VecAXPY(v,-dot,vi);CHKERRQ(ierr);
if (bv->indef) dot *= bv->omega[bv->nc+i];
if (H) H[bv->nc+i] += dot;
ierr = BVRestoreColumn(bv,i,&vi);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*@
BVInsertVec - Insert a vector into the specified column.
Collective on BV
Input Parameters:
+ V - basis vectors
. j - the column of V to be overwritten
- w - the vector to be copied
Level: intermediate
.seealso: BVInsertVecs()
@*/
PetscErrorCode BVInsertVec(BV V,PetscInt j,Vec w)
{
PetscErrorCode ierr;
PetscInt n,N;
Vec v;
PetscFunctionBegin;
PetscValidHeaderSpecific(V,BV_CLASSID,1);
PetscValidLogicalCollectiveInt(V,j,2);
PetscValidHeaderSpecific(w,VEC_CLASSID,3);
PetscValidType(V,1);
BVCheckSizes(V,1);
PetscCheckSameComm(V,1,w,3);
ierr = VecGetSize(w,&N);CHKERRQ(ierr);
ierr = VecGetLocalSize(w,&n);CHKERRQ(ierr);
if (N!=V->N || n!=V->n) SETERRQ4(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_INCOMP,"Vec sizes (global %D, local %D) do not match BV sizes (global %D, local %D)",N,n,V->N,V->n);
if (j<-V->nc || j>=V->m) SETERRQ3(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_OUTOFRANGE,"Argument j has wrong value %D, should be between %D and %D",j,-V->nc,V->m-1);
ierr = BVGetColumn(V,j,&v);CHKERRQ(ierr);
ierr = VecCopy(w,v);CHKERRQ(ierr);
ierr = BVRestoreColumn(V,j,&v);CHKERRQ(ierr);
ierr = PetscObjectStateIncrease((PetscObject)V);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
BVMultColumn - Computes y = beta*y + alpha*X*q, where y is the j-th column
of X.
Logically Collective on BV
Input Parameters:
+ X - a basis vectors object
. alpha,beta - scalars
. j - the column index
- q - an array of scalars
Notes:
This operation is equivalent to BVMultVec() but it uses column j of X
rather than taking a Vec as an argument. The number of active columns of
X is set to j before the computation, and restored afterwards.
If X has leading columns specified, then these columns do not participate
in the computation. Therefore, the length of array q must be equal to j
minus the number of leading columns.
Level: advanced
.seealso: BVMult(), BVMultVec(), BVMultInPlace(), BVSetActiveColumns()
@*/
PetscErrorCode BVMultColumn(BV X,PetscScalar alpha,PetscScalar beta,PetscInt j,PetscScalar *q)
{
PetscErrorCode ierr;
PetscInt ksave;
Vec y;
PetscFunctionBegin;
PetscValidHeaderSpecific(X,BV_CLASSID,1);
PetscValidLogicalCollectiveScalar(X,alpha,2);
PetscValidLogicalCollectiveScalar(X,beta,3);
PetscValidLogicalCollectiveInt(X,j,4);
PetscValidPointer(q,5);
PetscValidType(X,1);
BVCheckSizes(X,1);
if (j<0) SETERRQ(PetscObjectComm((PetscObject)X),PETSC_ERR_ARG_OUTOFRANGE,"Index j must be non-negative");
if (j>=X->m) SETERRQ2(PetscObjectComm((PetscObject)X),PETSC_ERR_ARG_OUTOFRANGE,"Index j=%D but BV only has %D columns",j,X->m);
ierr = PetscLogEventBegin(BV_Mult,X,0,0,0);CHKERRQ(ierr);
ksave = X->k;
X->k = j;
ierr = BVGetColumn(X,j,&y);CHKERRQ(ierr);
ierr = (*X->ops->multvec)(X,alpha,beta,y,q);CHKERRQ(ierr);
ierr = BVRestoreColumn(X,j,&y);CHKERRQ(ierr);
X->k = ksave;
ierr = PetscLogEventEnd(BV_Mult,X,0,0,0);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
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);
}
/*
BVOrthogonalizeCGS1 - Compute |v'| (estimated), |v| and one step of CGS with
only one global synchronization
*/
PetscErrorCode BVOrthogonalizeCGS1(BV bv,PetscInt j,Vec v,PetscScalar *H,PetscReal *onorm,PetscReal *norm)
{
PetscErrorCode ierr;
PetscInt i;
PetscReal sum,nrm,beta;
Vec w=v;
PetscFunctionBegin;
/* h = W^* v ; alpha = (v, v) */
bv->k = j;
if (onorm || norm) {
if (!v) {
bv->k++;
ierr = BVGetColumn(bv,j,&w);CHKERRQ(ierr);
}
ierr = BVDotVec(bv,w,H);CHKERRQ(ierr);
if (!v) {
ierr = BVRestoreColumn(bv,j,&w);CHKERRQ(ierr);
bv->k--;
beta = PetscSqrtReal(PetscRealPart(H[bv->nc+j]));
} else {
ierr = BVNormVec(bv,w,NORM_2,&beta);CHKERRQ(ierr);
}
} else {
if (!v) { ierr = BVDotColumn(bv,j,H);CHKERRQ(ierr); }
else { ierr = BVDotVec(bv,w,H);CHKERRQ(ierr); }
}
/* q = v - V h */
if (bv->indef) {
for (i=0;i<bv->nc+j;i++) H[i] /= bv->omega[i]; /* apply inverse of signature */
}
if (!v) { ierr = BVMultColumn(bv,-1.0,1.0,j,H);CHKERRQ(ierr); }
else { ierr = BVMultVec(bv,-1.0,1.0,w,H);CHKERRQ(ierr); }
if (bv->indef) {
for (i=0;i<bv->nc+j;i++) H[i] *= bv->omega[i]; /* revert signature */
}
/* compute |v| */
if (onorm) *onorm = beta;
if (bv->indef) {
if (!v) { ierr = BVNormColumn(bv,j,NORM_2,&nrm);CHKERRQ(ierr); }
else { ierr = BVNormVec(bv,w,NORM_2,&nrm);CHKERRQ(ierr); }
if (norm) *norm = nrm;
bv->omega[bv->nc+j] = (nrm<0.0)? -1.0: 1.0;
} else if (norm) {
/* estimate |v'| from |v| */
sum = 0.0;
for (i=0;i<bv->nc+j;i++) sum += PetscRealPart(H[i]*PetscConj(H[i]));
*norm = beta*beta-sum;
if (*norm <= 0.0) {
if (!v) { ierr = BVNormColumn(bv,j,NORM_2,norm);CHKERRQ(ierr); }
else { ierr = BVNormVec(bv,w,NORM_2,norm);CHKERRQ(ierr); }
} else *norm = PetscSqrtReal(*norm);
}
PetscFunctionReturn(0);
}
PetscErrorCode PEPComputeVectors_Indefinite(PEP pep)
{
PetscErrorCode ierr;
PetscInt n,i;
Mat Z;
Vec v;
#if !defined(PETSC_USE_COMPLEX)
Vec v1;
PetscScalar tmp;
PetscReal norm,normi;
#endif
PetscFunctionBegin;
ierr = DSGetDimensions(pep->ds,&n,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
ierr = DSVectors(pep->ds,DS_MAT_X,NULL,NULL);CHKERRQ(ierr);
ierr = DSGetMat(pep->ds,DS_MAT_X,&Z);CHKERRQ(ierr);
ierr = BVSetActiveColumns(pep->V,0,n);CHKERRQ(ierr);
ierr = BVMultInPlace(pep->V,Z,0,n);CHKERRQ(ierr);
ierr = MatDestroy(&Z);CHKERRQ(ierr);
/* normalization */
for (i=0;i<n;i++) {
#if !defined(PETSC_USE_COMPLEX)
if (pep->eigi[i] != 0.0) {
ierr = BVGetColumn(pep->V,i,&v);CHKERRQ(ierr);
ierr = BVGetColumn(pep->V,i+1,&v1);CHKERRQ(ierr);
ierr = VecNorm(v,NORM_2,&norm);CHKERRQ(ierr);
ierr = VecNorm(v1,NORM_2,&normi);CHKERRQ(ierr);
tmp = 1.0 / SlepcAbsEigenvalue(norm,normi);
ierr = VecScale(v,tmp);CHKERRQ(ierr);
ierr = VecScale(v1,tmp);CHKERRQ(ierr);
ierr = BVRestoreColumn(pep->V,i,&v);CHKERRQ(ierr);
ierr = BVRestoreColumn(pep->V,i+1,&v1);CHKERRQ(ierr);
i++;
} else
#endif
{
ierr = BVGetColumn(pep->V,i,&v);CHKERRQ(ierr);
ierr = VecNormalize(v,NULL);CHKERRQ(ierr);
ierr = BVRestoreColumn(pep->V,i,&v);CHKERRQ(ierr);
}
}
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);
}
/*@
SVDGetSingularTriplet - Gets the i-th triplet of the singular value decomposition
as computed by SVDSolve(). The solution consists in the singular value and its left
and right singular vectors.
Not Collective, but vectors are shared by all processors that share the SVD
Input Parameters:
+ svd - singular value solver context
- i - index of the solution
Output Parameters:
+ sigma - singular value
. u - left singular vector
- v - right singular vector
Note:
The index i should be a value between 0 and nconv-1 (see SVDGetConverged()).
Both U or V can be NULL if singular vectors are not required.
Level: beginner
.seealso: SVDSolve(), SVDGetConverged()
@*/
PetscErrorCode SVDGetSingularTriplet(SVD svd,PetscInt i,PetscReal *sigma,Vec u,Vec v)
{
PetscErrorCode ierr;
PetscReal norm;
PetscInt j,M,N;
Vec w,tl,vj,uj;
PetscFunctionBegin;
PetscValidHeaderSpecific(svd,SVD_CLASSID,1);
if (u) { PetscValidHeaderSpecific(u,VEC_CLASSID,4); PetscCheckSameComm(svd,1,u,4); }
if (v) { PetscValidHeaderSpecific(v,VEC_CLASSID,5); PetscCheckSameComm(svd,1,v,5); }
if (svd->reason == SVD_CONVERGED_ITERATING) SETERRQ(PetscObjectComm((PetscObject)svd),PETSC_ERR_ARG_WRONGSTATE,"SVDSolve must be called first");
if (i<0 || i>=svd->nconv) SETERRQ(PetscObjectComm((PetscObject)svd),PETSC_ERR_ARG_OUTOFRANGE,"Argument 2 out of range");
*sigma = svd->sigma[svd->perm[i]];
ierr = MatGetSize(svd->OP,&M,&N);CHKERRQ(ierr);
if (M<N) { w = u; u = v; v = w; }
if (u) {
if (!svd->lvecsavail) { /* generate left singular vectors on U */
if (!svd->U) { ierr = SVDGetBV(svd,NULL,&svd->U);CHKERRQ(ierr); }
ierr = SVDMatGetVecs(svd,NULL,&tl);CHKERRQ(ierr);
ierr = BVSetSizesFromVec(svd->U,tl,svd->ncv);CHKERRQ(ierr);
ierr = VecDestroy(&tl);CHKERRQ(ierr);
for (j=0;j<svd->nconv;j++) {
ierr = BVGetColumn(svd->V,j,&vj);CHKERRQ(ierr);
ierr = BVGetColumn(svd->U,j,&uj);CHKERRQ(ierr);
ierr = SVDMatMult(svd,PETSC_FALSE,vj,uj);CHKERRQ(ierr);
ierr = BVRestoreColumn(svd->V,j,&vj);CHKERRQ(ierr);
ierr = BVRestoreColumn(svd->U,j,&uj);CHKERRQ(ierr);
ierr = BVOrthogonalizeColumn(svd->U,j,NULL,&norm,NULL);CHKERRQ(ierr);
ierr = BVScaleColumn(svd->U,j,1.0/norm);CHKERRQ(ierr);
}
svd->lvecsavail = PETSC_TRUE;
}
ierr = BVCopyVec(svd->U,svd->perm[i],u);CHKERRQ(ierr);
}
if (v) {
ierr = BVCopyVec(svd->V,svd->perm[i],v);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*@
BVMatMultColumn - Computes the matrix-vector product for a specified
column, storing the result in the next column: v_{j+1}=A*v_j.
Neighbor-wise Collective on Mat and BV
Input Parameters:
+ V - basis vectors context
. A - the matrix
- j - the column
Output Parameter:
. Y - the result
Level: beginner
.seealso: BVMatMult()
@*/
PetscErrorCode BVMatMultColumn(BV V,Mat A,PetscInt j)
{
PetscErrorCode ierr;
Vec vj,vj1;
PetscFunctionBegin;
PetscValidHeaderSpecific(V,BV_CLASSID,1);
PetscValidType(V,1);
BVCheckSizes(V,1);
PetscValidHeaderSpecific(A,MAT_CLASSID,2);
PetscCheckSameComm(V,1,A,2);
if (j<0) SETERRQ(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_OUTOFRANGE,"Index j must be non-negative");
if (j+1>=V->m) SETERRQ2(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_OUTOFRANGE,"Result should go in index j+1=%D but BV only has %D columns",j+1,V->m);
ierr = PetscLogEventBegin(BV_MatMult,V,A,0,0);CHKERRQ(ierr);
ierr = BVGetColumn(V,j,&vj);CHKERRQ(ierr);
ierr = BVGetColumn(V,j+1,&vj1);CHKERRQ(ierr);
ierr = MatMult(A,vj,vj1);CHKERRQ(ierr);
ierr = BVRestoreColumn(V,j,&vj);CHKERRQ(ierr);
ierr = BVRestoreColumn(V,j+1,&vj1);CHKERRQ(ierr);
ierr = PetscLogEventEnd(BV_MatMult,V,A,0,0);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
PEPSetWorkVecs - Sets a number of work vectors into a PEP object.
Collective on PEP
Input Parameters:
+ pep - polynomial eigensolver context
- nw - number of work vectors to allocate
Developers Note:
This is PETSC_EXTERN because it may be required by user plugin PEP
implementations.
Level: developer
@*/
PetscErrorCode PEPSetWorkVecs(PEP pep,PetscInt nw)
{
PetscErrorCode ierr;
Vec t;
PetscFunctionBegin;
if (pep->nwork != nw) {
ierr = VecDestroyVecs(pep->nwork,&pep->work);CHKERRQ(ierr);
pep->nwork = nw;
ierr = BVGetColumn(pep->V,0,&t);CHKERRQ(ierr);
ierr = VecDuplicateVecs(t,nw,&pep->work);CHKERRQ(ierr);
ierr = BVRestoreColumn(pep->V,0,&t);CHKERRQ(ierr);
ierr = PetscLogObjectParents(pep,nw,pep->work);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*@
BVInsertVecs - Insert a set of vectors into the specified columns.
Collective on BV
Input Parameters:
+ V - basis vectors
. s - first column of V to be overwritten
. W - set of vectors to be copied
- orth - flag indicating if the vectors must be orthogonalized
Input/Output Parameter:
. m - number of input vectors, on output the number of linearly independent
vectors
Notes:
Copies the contents of vectors W to V(:,s:s+n). If the orthogonalization
flag is set, then the vectors are copied one by one and then orthogonalized
against the previous ones. If any of them is linearly dependent then it
is discarded and the value of m is decreased.
Level: intermediate
.seealso: BVInsertVec(), BVOrthogonalizeColumn()
@*/
PetscErrorCode BVInsertVecs(BV V,PetscInt s,PetscInt *m,Vec *W,PetscBool orth)
{
PetscErrorCode ierr;
PetscInt n,N,i,ndep;
PetscBool lindep;
PetscReal norm;
Vec v;
PetscFunctionBegin;
PetscValidHeaderSpecific(V,BV_CLASSID,1);
PetscValidLogicalCollectiveInt(V,s,2);
PetscValidPointer(m,3);
PetscValidLogicalCollectiveInt(V,*m,3);
if (!*m) PetscFunctionReturn(0);
if (*m<0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Number of vectors (given %D) cannot be negative",*m);
PetscValidPointer(W,4);
PetscValidHeaderSpecific(*W,VEC_CLASSID,4);
PetscValidLogicalCollectiveBool(V,orth,5);
PetscValidType(V,1);
BVCheckSizes(V,1);
PetscCheckSameComm(V,1,*W,4);
ierr = VecGetSize(*W,&N);CHKERRQ(ierr);
ierr = VecGetLocalSize(*W,&n);CHKERRQ(ierr);
if (N!=V->N || n!=V->n) SETERRQ4(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_INCOMP,"Vec sizes (global %D, local %D) do not match BV sizes (global %D, local %D)",N,n,V->N,V->n);
if (s<0 || s>=V->m) SETERRQ2(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_OUTOFRANGE,"Argument s has wrong value %D, should be between 0 and %D",s,V->m-1);
if (s+(*m)>V->m) SETERRQ1(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_OUTOFRANGE,"Too many vectors provided, there is only room for %D",V->m);
ndep = 0;
for (i=0;i<*m;i++) {
ierr = BVGetColumn(V,s+i-ndep,&v);CHKERRQ(ierr);
ierr = VecCopy(W[i],v);CHKERRQ(ierr);
ierr = BVRestoreColumn(V,s+i-ndep,&v);CHKERRQ(ierr);
if (orth) {
ierr = BVOrthogonalizeColumn(V,s+i-ndep,NULL,&norm,&lindep);CHKERRQ(ierr);
if (norm==0.0 || lindep) {
ierr = PetscInfo1(V,"Removing linearly dependent vector %D\n",i);CHKERRQ(ierr);
ndep++;
} else {
ierr = BVScaleColumn(V,s+i-ndep,1.0/norm);CHKERRQ(ierr);
}
}
}
*m -= ndep;
ierr = PetscObjectStateIncrease((PetscObject)V);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);
}
/*@
BVSetRandom - Set the columns of a BV to random numbers.
Logically Collective on BV
Input Parameters:
+ bv - basis vectors
- rctx - the random number context, formed by PetscRandomCreate(), or NULL and
it will create one internally.
Note:
All active columns (except the leading ones) are modified.
Level: advanced
.seealso: BVSetRandomColumn(), BVSetActiveColumns()
@*/
PetscErrorCode BVSetRandom(BV bv,PetscRandom rctx)
{
PetscErrorCode ierr;
PetscRandom rand=NULL;
PetscInt i,low,high,k;
PetscScalar *px,t;
Vec x;
PetscFunctionBegin;
PetscValidHeaderSpecific(bv,BV_CLASSID,1);
if (rctx) PetscValidHeaderSpecific(rctx,PETSC_RANDOM_CLASSID,2);
else {
ierr = PetscRandomCreate(PetscObjectComm((PetscObject)bv),&rand);CHKERRQ(ierr);
ierr = PetscRandomSetSeed(rand,0x12345678);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rand);CHKERRQ(ierr);
rctx = rand;
}
PetscValidType(bv,1);
BVCheckSizes(bv,1);
ierr = PetscLogEventBegin(BV_SetRandom,bv,rctx,0,0);CHKERRQ(ierr);
for (k=bv->l;k<bv->k;k++) {
ierr = BVGetColumn(bv,k,&x);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(x,&low,&high);CHKERRQ(ierr);
ierr = VecGetArray(x,&px);CHKERRQ(ierr);
for (i=0;i<bv->N;i++) {
ierr = PetscRandomGetValue(rctx,&t);CHKERRQ(ierr);
if (i>=low && i<high) px[i-low] = t;
}
ierr = VecRestoreArray(x,&px);CHKERRQ(ierr);
ierr = BVRestoreColumn(bv,k,&x);CHKERRQ(ierr);
}
ierr = PetscLogEventEnd(BV_SetRandom,bv,rctx,0,0);CHKERRQ(ierr);
ierr = PetscRandomDestroy(&rand);CHKERRQ(ierr);
ierr = PetscObjectStateIncrease((PetscObject)bv);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
BVSetRandomColumn - Set one column of a BV to random numbers.
Logically Collective on BV
Input Parameters:
+ bv - basis vectors
. j - column number to be set
- rctx - the random number context, formed by PetscRandomCreate(), or NULL and
it will create one internally.
Note:
This operation is analogue to VecSetRandom - the difference is that the
generated random vector is the same irrespective of the size of the
communicator (if all processes pass a PetscRandom context initialized
with the same seed).
Level: advanced
.seealso: BVSetRandom(), BVSetActiveColumns()
@*/
PetscErrorCode BVSetRandomColumn(BV bv,PetscInt j,PetscRandom rctx)
{
PetscErrorCode ierr;
PetscRandom rand=NULL;
PetscInt i,low,high;
PetscScalar *px,t;
Vec x;
PetscFunctionBegin;
PetscValidHeaderSpecific(bv,BV_CLASSID,1);
PetscValidLogicalCollectiveInt(bv,j,2);
if (rctx) PetscValidHeaderSpecific(rctx,PETSC_RANDOM_CLASSID,3);
else {
ierr = PetscRandomCreate(PetscObjectComm((PetscObject)bv),&rand);CHKERRQ(ierr);
ierr = PetscRandomSetSeed(rand,0x12345678);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rand);CHKERRQ(ierr);
rctx = rand;
}
PetscValidType(bv,1);
BVCheckSizes(bv,1);
if (j<0 || j>=bv->m) SETERRQ2(PetscObjectComm((PetscObject)bv),PETSC_ERR_ARG_OUTOFRANGE,"Argument j has wrong value %D, the number of columns is %D",j,bv->m);
ierr = PetscLogEventBegin(BV_SetRandom,bv,rctx,0,0);CHKERRQ(ierr);
ierr = BVGetColumn(bv,j,&x);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(x,&low,&high);CHKERRQ(ierr);
ierr = VecGetArray(x,&px);CHKERRQ(ierr);
for (i=0;i<bv->N;i++) {
ierr = PetscRandomGetValue(rctx,&t);CHKERRQ(ierr);
if (i>=low && i<high) px[i-low] = t;
}
ierr = VecRestoreArray(x,&px);CHKERRQ(ierr);
ierr = BVRestoreColumn(bv,j,&x);CHKERRQ(ierr);
ierr = PetscLogEventEnd(BV_SetRandom,bv,rctx,0,0);CHKERRQ(ierr);
ierr = PetscRandomDestroy(&rand);CHKERRQ(ierr);
ierr = PetscObjectStateIncrease((PetscObject)bv);CHKERRQ(ierr);
PetscFunctionReturn(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);
}
int main(int argc,char **argv)
{
PetscErrorCode ierr;
BV X;
Mat M;
Vec v,t,*C;
PetscInt i,j,n=20,k=8,nc=2;
PetscViewer view;
PetscBool verbose;
PetscReal norm;
PetscScalar alpha;
SlepcInitialize(&argc,&argv,(char*)0,help);
ierr = PetscOptionsGetInt(NULL,"-n",&n,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,"-k",&k,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,"-nc",&nc,NULL);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,"-verbose",&verbose);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Test BV orthogonalization with %D columns + %D constraints, of length %D.\n",k,nc,n);CHKERRQ(ierr);
/* Create template vector */
ierr = VecCreate(PETSC_COMM_WORLD,&t);CHKERRQ(ierr);
ierr = VecSetSizes(t,PETSC_DECIDE,n);CHKERRQ(ierr);
ierr = VecSetFromOptions(t);CHKERRQ(ierr);
/* Create BV object X */
ierr = BVCreate(PETSC_COMM_WORLD,&X);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject)X,"X");CHKERRQ(ierr);
ierr = BVSetSizesFromVec(X,t,k);CHKERRQ(ierr);
ierr = BVSetFromOptions(X);CHKERRQ(ierr);
/* Generate constraints and attach them to X */
if (nc>0) {
ierr = VecDuplicateVecs(t,nc,&C);CHKERRQ(ierr);
for (j=0;j<nc;j++) {
for (i=0;i<=j;i++) {
ierr = VecSetValue(C[j],i,1.0,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = VecAssemblyBegin(C[j]);CHKERRQ(ierr);
ierr = VecAssemblyEnd(C[j]);CHKERRQ(ierr);
}
ierr = BVInsertConstraints(X,&nc,C);CHKERRQ(ierr);
ierr = VecDestroyVecs(nc,&C);CHKERRQ(ierr);
}
/* Set up viewer */
ierr = PetscViewerASCIIGetStdout(PETSC_COMM_WORLD,&view);CHKERRQ(ierr);
if (verbose) {
ierr = PetscViewerPushFormat(view,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
}
/* Fill X entries */
for (j=0;j<k;j++) {
ierr = BVGetColumn(X,j,&v);CHKERRQ(ierr);
ierr = VecZeroEntries(v);CHKERRQ(ierr);
for (i=0;i<=n/2;i++) {
if (i+j<n) {
alpha = (3.0*i+j-2)/(2*(i+j+1));
ierr = VecSetValue(v,i+j,alpha,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
ierr = BVRestoreColumn(X,j,&v);CHKERRQ(ierr);
}
if (verbose) {
ierr = BVView(X,view);CHKERRQ(ierr);
}
/* Test BVOrthogonalizeColumn */
for (j=0;j<k;j++) {
ierr = BVOrthogonalizeColumn(X,j,NULL,&norm,NULL);CHKERRQ(ierr);
alpha = 1.0/norm;
ierr = BVScaleColumn(X,j,alpha);CHKERRQ(ierr);
}
if (verbose) {
ierr = BVView(X,view);CHKERRQ(ierr);
}
/* Check orthogonality */
ierr = MatCreateSeqDense(PETSC_COMM_SELF,k,k,NULL,&M);CHKERRQ(ierr);
ierr = BVDot(X,X,M);CHKERRQ(ierr);
ierr = MatShift(M,-1.0);CHKERRQ(ierr);
ierr = MatNorm(M,NORM_1,&norm);CHKERRQ(ierr);
if (norm<100*PETSC_MACHINE_EPSILON) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"Level of orthogonality < 100*eps\n");CHKERRQ(ierr);
} else {
ierr = PetscPrintf(PETSC_COMM_WORLD,"Level of orthogonality: %g\n",(double)norm);CHKERRQ(ierr);
}
ierr = MatDestroy(&M);CHKERRQ(ierr);
ierr = BVDestroy(&X);CHKERRQ(ierr);
ierr = VecDestroy(&t);CHKERRQ(ierr);
ierr = SlepcFinalize();
return 0;
}
static PetscErrorCode SVDOneSideTRLanczosCGS(SVD svd,PetscReal *alpha,PetscReal *beta,BV V,BV U,PetscInt nconv,PetscInt l,PetscInt n,PetscScalar* work)
{
PetscErrorCode ierr;
PetscReal a,b,eta;
PetscScalar gamma;
PetscInt i,j,k=nconv+l;
Vec ui,ui1,vi;
BVOrthogRefineType refine;
PetscFunctionBegin;
ierr = BVGetColumn(V,k,&vi);CHKERRQ(ierr);
ierr = BVGetColumn(U,k,&ui);CHKERRQ(ierr);
ierr = SVDMatMult(svd,PETSC_FALSE,vi,ui);CHKERRQ(ierr);
ierr = BVRestoreColumn(V,k,&vi);CHKERRQ(ierr);
ierr = BVRestoreColumn(U,k,&ui);CHKERRQ(ierr);
if (l>0) {
ierr = BVMultColumn(U,-1.0,1.0,k,&gamma);CHKERRQ(ierr);
beta[nconv] = PetscRealPart(gamma);
}
ierr = BVGetOrthogonalization(V,NULL,&refine,&eta);CHKERRQ(ierr);
for (i=k+1;i<n;i++) {
ierr = BVGetColumn(V,i,&vi);CHKERRQ(ierr);
ierr = BVGetColumn(U,i-1,&ui1);CHKERRQ(ierr);
ierr = SVDMatMult(svd,PETSC_TRUE,ui1,vi);CHKERRQ(ierr);
ierr = BVRestoreColumn(V,i,&vi);CHKERRQ(ierr);
ierr = BVRestoreColumn(U,i-1,&ui1);CHKERRQ(ierr);
ierr = BVNormColumn(U,i-1,NORM_2,&a);CHKERRQ(ierr);
if (refine == BV_ORTHOG_REFINE_IFNEEDED) {
ierr = BVSetActiveColumns(V,0,i+1);CHKERRQ(ierr);
ierr = BVGetColumn(V,i,&vi);CHKERRQ(ierr);
ierr = BVDotVec(V,vi,work);CHKERRQ(ierr);
ierr = BVRestoreColumn(V,i,&vi);CHKERRQ(ierr);
ierr = BVSetActiveColumns(V,0,i);CHKERRQ(ierr);
} else {
ierr = BVSetActiveColumns(V,0,i);CHKERRQ(ierr);
ierr = BVDotColumn(V,i,work);CHKERRQ(ierr);
}
ierr = BVScaleColumn(U,i-1,1.0/a);CHKERRQ(ierr);
for (j=0;j<i;j++) work[j] = work[j] / a;
ierr = BVMultColumn(V,-1.0,1.0/a,i,work);CHKERRQ(ierr);
ierr = SVDOrthogonalizeCGS(V,i,work,a,refine,eta,&b);CHKERRQ(ierr);
ierr = BVScaleColumn(V,i,1.0/b);CHKERRQ(ierr);
ierr = BVGetColumn(V,i,&vi);CHKERRQ(ierr);
ierr = BVGetColumn(U,i,&ui);CHKERRQ(ierr);
ierr = BVGetColumn(U,i-1,&ui1);CHKERRQ(ierr);
ierr = SVDMatMult(svd,PETSC_FALSE,vi,ui);CHKERRQ(ierr);
ierr = VecAXPY(ui,-b,ui1);CHKERRQ(ierr);
ierr = BVRestoreColumn(V,i,&vi);CHKERRQ(ierr);
ierr = BVRestoreColumn(U,i,&ui);CHKERRQ(ierr);
ierr = BVRestoreColumn(U,i-1,&ui1);CHKERRQ(ierr);
alpha[i-1] = a;
beta[i-1] = b;
}
ierr = BVGetColumn(V,n,&vi);CHKERRQ(ierr);
ierr = BVGetColumn(U,n-1,&ui1);CHKERRQ(ierr);
ierr = SVDMatMult(svd,PETSC_TRUE,ui1,vi);CHKERRQ(ierr);
ierr = BVRestoreColumn(V,n,&vi);CHKERRQ(ierr);
ierr = BVRestoreColumn(U,n-1,&ui1);CHKERRQ(ierr);
ierr = BVNormColumn(svd->U,n-1,NORM_2,&a);CHKERRQ(ierr);
if (refine == BV_ORTHOG_REFINE_IFNEEDED) {
ierr = BVSetActiveColumns(V,0,n+1);CHKERRQ(ierr);
ierr = BVGetColumn(V,n,&vi);CHKERRQ(ierr);
ierr = BVDotVec(V,vi,work);CHKERRQ(ierr);
ierr = BVRestoreColumn(V,n,&vi);CHKERRQ(ierr);
} else {
ierr = BVSetActiveColumns(V,0,n);CHKERRQ(ierr);
ierr = BVDotColumn(V,n,work);CHKERRQ(ierr);
}
ierr = BVScaleColumn(U,n-1,1.0/a);CHKERRQ(ierr);
for (j=0;j<n;j++) work[j] = work[j] / a;
ierr = BVMultColumn(V,-1.0,1.0/a,n,work);CHKERRQ(ierr);
ierr = SVDOrthogonalizeCGS(V,n,work,a,refine,eta,&b);CHKERRQ(ierr);
ierr = BVSetActiveColumns(V,nconv,n);CHKERRQ(ierr);
alpha[n-1] = a;
beta[n-1] = b;
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);
}
/*
BVOrthogonalizeMGS - Orthogonalize with modified Gram-Schmidt
*/
static PetscErrorCode BVOrthogonalizeMGS(BV bv,PetscInt j,Vec v,PetscBool *which,PetscScalar *H,PetscReal *norm,PetscBool *lindep)
{
PetscErrorCode ierr;
PetscReal onrm,nrm;
PetscInt k,l;
Vec w;
PetscFunctionBegin;
if (v) {
w = v;
k = bv->k;
} else {
ierr = BVGetColumn(bv,j,&w);CHKERRQ(ierr);
k = j;
}
ierr = PetscMemzero(bv->h,(bv->nc+k)*sizeof(PetscScalar));CHKERRQ(ierr);
switch (bv->orthog_ref) {
case BV_ORTHOG_REFINE_IFNEEDED:
/* first step */
ierr = BVNormVec(bv,w,NORM_2,&onrm);CHKERRQ(ierr);
ierr = BVOrthogonalizeMGS1(bv,k,w,which,bv->h);CHKERRQ(ierr);
ierr = BVNormVec(bv,w,NORM_2,&nrm);CHKERRQ(ierr);
/* ||q|| < eta ||h|| */
l = 1;
while (l<3 && nrm && nrm < bv->orthog_eta*onrm) {
l++;
onrm = nrm;
ierr = BVOrthogonalizeMGS1(bv,k,w,which,bv->c);CHKERRQ(ierr);
ierr = BVNormVec(bv,w,NORM_2,&nrm);CHKERRQ(ierr);
}
if (lindep) {
if (nrm < bv->orthog_eta*onrm) *lindep = PETSC_TRUE;
else *lindep = PETSC_FALSE;
}
break;
case BV_ORTHOG_REFINE_NEVER:
ierr = BVOrthogonalizeMGS1(bv,k,w,which,bv->h);CHKERRQ(ierr);
/* compute |v| */
if (norm || lindep) {
ierr = BVNormVec(bv,w,NORM_2,&nrm);CHKERRQ(ierr);
}
/* linear dependence check: just test for exactly zero norm */
if (lindep) *lindep = nrm? PETSC_FALSE: PETSC_TRUE;
break;
case BV_ORTHOG_REFINE_ALWAYS:
/* first step */
ierr = BVOrthogonalizeMGS1(bv,k,w,which,bv->h);CHKERRQ(ierr);
if (lindep) {
ierr = BVNormVec(bv,w,NORM_2,&onrm);CHKERRQ(ierr);
}
/* second step */
ierr = BVOrthogonalizeMGS1(bv,k,w,which,bv->h);CHKERRQ(ierr);
if (norm || lindep) {
ierr = BVNormVec(bv,w,NORM_2,&nrm);CHKERRQ(ierr);
}
if (lindep) {
if (nrm==0.0 || nrm < bv->orthog_eta*onrm) *lindep = PETSC_TRUE;
else *lindep = PETSC_FALSE;
}
break;
}
if (bv->indef) {
ierr = BVNormVec(bv,w,NORM_2,&nrm);CHKERRQ(ierr);
bv->omega[bv->nc+j] = (nrm<0.0)? -1.0: 1.0;
}
if (!v) { ierr = BVRestoreColumn(bv,j,&w);CHKERRQ(ierr); }
if (norm) *norm = nrm;
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);
}
/*@
EPSSolve - Solves the eigensystem.
Collective on EPS
Input Parameter:
. eps - eigensolver context obtained from EPSCreate()
Options Database Keys:
+ -eps_view - print information about the solver used
. -eps_view_mat0 binary - save the first matrix (A) to the default binary viewer
. -eps_view_mat1 binary - save the second matrix (B) to the default binary viewer
- -eps_plot_eigs - plot computed eigenvalues
Level: beginner
.seealso: EPSCreate(), EPSSetUp(), EPSDestroy(), EPSSetTolerances()
@*/
PetscErrorCode EPSSolve(EPS eps)
{
PetscErrorCode ierr;
PetscInt i,nmat;
PetscReal re,im;
PetscScalar dot;
PetscBool flg,iscayley;
PetscViewer viewer;
PetscViewerFormat format;
PetscDraw draw;
PetscDrawSP drawsp;
STMatMode matmode;
Mat A,B;
Vec w,x;
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_CLASSID,1);
ierr = PetscLogEventBegin(EPS_Solve,eps,0,0,0);CHKERRQ(ierr);
/* call setup */
ierr = EPSSetUp(eps);CHKERRQ(ierr);
eps->nconv = 0;
eps->its = 0;
for (i=0;i<eps->ncv;i++) {
eps->eigr[i] = 0.0;
eps->eigi[i] = 0.0;
eps->errest[i] = 0.0;
}
ierr = EPSMonitor(eps,eps->its,eps->nconv,eps->eigr,eps->eigi,eps->errest,eps->ncv);CHKERRQ(ierr);
/* call solver */
ierr = (*eps->ops->solve)(eps);CHKERRQ(ierr);
eps->state = EPS_STATE_SOLVED;
ierr = STGetMatMode(eps->st,&matmode);CHKERRQ(ierr);
if (matmode == ST_MATMODE_INPLACE && eps->ispositive) {
/* Purify eigenvectors before reverting operator */
ierr = EPSComputeVectors(eps);CHKERRQ(ierr);
}
ierr = STPostSolve(eps->st);CHKERRQ(ierr);
if (!eps->reason) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_PLIB,"Internal error, solver returned without setting converged reason");
/* Map eigenvalues back to the original problem, necessary in some
* spectral transformations */
if (eps->ops->backtransform) {
ierr = (*eps->ops->backtransform)(eps);CHKERRQ(ierr);
}
#if !defined(PETSC_USE_COMPLEX)
/* reorder conjugate eigenvalues (positive imaginary first) */
for (i=0; i<eps->nconv-1; i++) {
if (eps->eigi[i] != 0) {
if (eps->eigi[i] < 0) {
eps->eigi[i] = -eps->eigi[i];
eps->eigi[i+1] = -eps->eigi[i+1];
/* the next correction only works with eigenvectors */
ierr = EPSComputeVectors(eps);CHKERRQ(ierr);
ierr = BVScaleColumn(eps->V,i+1,-1.0);CHKERRQ(ierr);
}
i++;
}
}
#endif
ierr = STGetNumMatrices(eps->st,&nmat);CHKERRQ(ierr);
ierr = STGetOperators(eps->st,0,&A);CHKERRQ(ierr);
if (nmat>1) { ierr = STGetOperators(eps->st,1,&B);CHKERRQ(ierr); }
/* In the case of Cayley transform, eigenvectors need to be B-normalized */
ierr = PetscObjectTypeCompare((PetscObject)eps->st,STCAYLEY,&iscayley);CHKERRQ(ierr);
if (iscayley && eps->isgeneralized && eps->ishermitian) {
ierr = MatGetVecs(B,NULL,&w);CHKERRQ(ierr);
ierr = EPSComputeVectors(eps);CHKERRQ(ierr);
for (i=0;i<eps->nconv;i++) {
ierr = BVGetColumn(eps->V,i,&x);CHKERRQ(ierr);
ierr = MatMult(B,x,w);CHKERRQ(ierr);
ierr = VecDot(w,x,&dot);CHKERRQ(ierr);
ierr = VecScale(x,1.0/PetscSqrtScalar(dot));CHKERRQ(ierr);
ierr = BVRestoreColumn(eps->V,i,&x);CHKERRQ(ierr);
}
ierr = VecDestroy(&w);CHKERRQ(ierr);
}
/* sort eigenvalues according to eps->which parameter */
ierr = SlepcSortEigenvalues(eps->sc,eps->nconv,eps->eigr,eps->eigi,eps->perm);CHKERRQ(ierr);
ierr = PetscLogEventEnd(EPS_Solve,eps,0,0,0);CHKERRQ(ierr);
/* various viewers */
ierr = MatViewFromOptions(A,((PetscObject)eps)->prefix,"-eps_view_mat0");CHKERRQ(ierr);
if (nmat>1) { ierr = MatViewFromOptions(B,((PetscObject)eps)->prefix,"-eps_view_mat1");CHKERRQ(ierr); }
ierr = PetscOptionsGetViewer(PetscObjectComm((PetscObject)eps),((PetscObject)eps)->prefix,"-eps_view",&viewer,&format,&flg);CHKERRQ(ierr);
if (flg && !PetscPreLoadingOn) {
ierr = PetscViewerPushFormat(viewer,format);CHKERRQ(ierr);
ierr = EPSView(eps,viewer);CHKERRQ(ierr);
ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
}
flg = PETSC_FALSE;
ierr = PetscOptionsGetBool(((PetscObject)eps)->prefix,"-eps_plot_eigs",&flg,NULL);CHKERRQ(ierr);
if (flg) {
ierr = PetscViewerDrawOpen(PETSC_COMM_SELF,0,"Computed Eigenvalues",PETSC_DECIDE,PETSC_DECIDE,300,300,&viewer);CHKERRQ(ierr);
ierr = PetscViewerDrawGetDraw(viewer,0,&draw);CHKERRQ(ierr);
ierr = PetscDrawSPCreate(draw,1,&drawsp);CHKERRQ(ierr);
for (i=0;i<eps->nconv;i++) {
#if defined(PETSC_USE_COMPLEX)
re = PetscRealPart(eps->eigr[i]);
im = PetscImaginaryPart(eps->eigi[i]);
#else
re = eps->eigr[i];
im = eps->eigi[i];
#endif
ierr = PetscDrawSPAddPoint(drawsp,&re,&im);CHKERRQ(ierr);
}
ierr = PetscDrawSPDraw(drawsp,PETSC_TRUE);CHKERRQ(ierr);
ierr = PetscDrawSPDestroy(&drawsp);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
}
/* Remove deflation and initial subspaces */
eps->nds = 0;
eps->nini = 0;
PetscFunctionReturn(0);
}
PetscErrorCode NEPSolve_RII(NEP nep)
{
PetscErrorCode ierr;
Mat T=nep->function,Tp=nep->jacobian,Tsigma;
Vec u,r=nep->work[0],delta=nep->work[1];
PetscScalar lambda,a1,a2;
PetscReal relerr;
PetscBool hascopy;
KSPConvergedReason kspreason;
PetscFunctionBegin;
/* get initial approximation of eigenvalue and eigenvector */
ierr = NEPGetDefaultShift(nep,&lambda);CHKERRQ(ierr);
if (!nep->nini) {
ierr = BVSetRandomColumn(nep->V,0,nep->rand);CHKERRQ(ierr);
}
ierr = BVGetColumn(nep->V,0,&u);CHKERRQ(ierr);
/* correct eigenvalue approximation: lambda = lambda - (u'*T*u)/(u'*Tp*u) */
ierr = NEPComputeFunction(nep,lambda,T,T);CHKERRQ(ierr);
ierr = MatMult(T,u,r);CHKERRQ(ierr);
ierr = VecDot(u,r,&a1);CHKERRQ(ierr);
ierr = NEPApplyJacobian(nep,lambda,u,delta,r,Tp);CHKERRQ(ierr);
ierr = VecDot(u,r,&a2);CHKERRQ(ierr);
lambda = lambda - a1/a2;
/* prepare linear solver */
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++;
/* update preconditioner and set adaptive tolerance */
if (nep->lag && !(nep->its%nep->lag) && nep->its>2*nep->lag && relerr<1e-2) {
ierr = MatHasOperation(T,MATOP_COPY,&hascopy);CHKERRQ(ierr);
if (hascopy) {
ierr = MatCopy(T,Tsigma,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
} else {
ierr = MatDestroy(&Tsigma);CHKERRQ(ierr);
ierr = MatDuplicate(T,MAT_COPY_VALUES,&Tsigma);CHKERRQ(ierr);
}
ierr = KSPSetOperators(nep->ksp,Tsigma,Tsigma);CHKERRQ(ierr);
}
if (!nep->cctol) {
nep->ktol = PetscMax(nep->ktol/2.0,PETSC_MACHINE_EPSILON*10.0);
ierr = KSPSetTolerances(nep->ksp,nep->ktol,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT);CHKERRQ(ierr);
}
/* form residual, r = T(lambda)*u */
ierr = NEPApplyFunction(nep,lambda,u,delta,r,T,T);CHKERRQ(ierr);
/* convergence test */
ierr = VecNorm(r,NORM_2,&relerr);CHKERRQ(ierr);
nep->errest[nep->nconv] = relerr;
nep->eigr[nep->nconv] = lambda;
if (relerr<=nep->rtol) {
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->nconv) {
/* eigenvector correction: delta = T(sigma)\r */
ierr = NEP_KSPSolve(nep,r,delta);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;
}
/* update eigenvector: u = u - delta */
ierr = VecAXPY(u,-1.0,delta);CHKERRQ(ierr);
/* normalize eigenvector */
ierr = VecNormalize(u,NULL);CHKERRQ(ierr);
/* correct eigenvalue: lambda = lambda - (u'*T*u)/(u'*Tp*u) */
ierr = NEPApplyFunction(nep,lambda,u,delta,r,T,T);CHKERRQ(ierr);
ierr = VecDot(u,r,&a1);CHKERRQ(ierr);
ierr = NEPApplyJacobian(nep,lambda,u,delta,r,Tp);CHKERRQ(ierr);
ierr = VecDot(u,r,&a2);CHKERRQ(ierr);
lambda = lambda - a1/a2;
}
if (nep->its >= nep->max_it) nep->reason = NEP_DIVERGED_MAX_IT;
}
ierr = MatDestroy(&Tsigma);CHKERRQ(ierr);
ierr = BVRestoreColumn(nep->V,0,&u);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode NEPSolve_SLP(NEP nep)
{
PetscErrorCode ierr;
NEP_SLP *ctx = (NEP_SLP*)nep->data;
Mat T=nep->function,Tp=nep->jacobian;
Vec u,r=nep->work[0];
PetscScalar lambda,mu,im;
PetscReal relerr;
PetscInt nconv;
PetscFunctionBegin;
/* get initial approximation of eigenvalue and eigenvector */
ierr = NEPGetDefaultShift(nep,&lambda);CHKERRQ(ierr);
if (!nep->nini) {
ierr = BVSetRandomColumn(nep->V,0,nep->rand);CHKERRQ(ierr);
}
ierr = BVGetColumn(nep->V,0,&u);CHKERRQ(ierr);
/* Restart loop */
while (nep->reason == NEP_CONVERGED_ITERATING) {
nep->its++;
/* evaluate T(lambda) and T'(lambda) */
ierr = NEPComputeFunction(nep,lambda,T,T);CHKERRQ(ierr);
ierr = NEPComputeJacobian(nep,lambda,Tp);CHKERRQ(ierr);
/* form residual, r = T(lambda)*u (used in convergence test only) */
ierr = MatMult(T,u,r);CHKERRQ(ierr);
/* convergence test */
ierr = VecNorm(r,NORM_2,&relerr);CHKERRQ(ierr);
nep->errest[nep->nconv] = relerr;
nep->eigr[nep->nconv] = lambda;
if (relerr<=nep->rtol) {
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->nconv) {
/* compute eigenvalue correction mu and eigenvector approximation u */
ierr = EPSSetOperators(ctx->eps,T,Tp);CHKERRQ(ierr);
ierr = EPSSetInitialSpace(ctx->eps,1,&u);CHKERRQ(ierr);
ierr = EPSSolve(ctx->eps);CHKERRQ(ierr);
ierr = EPSGetConverged(ctx->eps,&nconv);CHKERRQ(ierr);
if (!nconv) {
ierr = PetscInfo1(nep,"iter=%D, inner iteration failed, stopping solve\n",nep->its);CHKERRQ(ierr);
nep->reason = NEP_DIVERGED_LINEAR_SOLVE;
break;
}
ierr = EPSGetEigenpair(ctx->eps,0,&mu,&im,u,NULL);CHKERRQ(ierr);
if (PetscAbsScalar(im)>PETSC_MACHINE_EPSILON) SETERRQ(PetscObjectComm((PetscObject)nep),1,"Complex eigenvalue approximation - not implemented in real scalars");
/* correct eigenvalue */
lambda = lambda - mu;
}
if (nep->its >= nep->max_it) nep->reason = NEP_DIVERGED_MAX_IT;
}
ierr = BVRestoreColumn(nep->V,0,&u);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);
}
int main(int argc,char **argv)
{
PetscErrorCode ierr;
Vec t,v;
Mat B,M;
BV X;
PetscInt i,j,n=10,k=5,Istart,Iend,col[3];
PetscScalar value[3],alpha;
PetscReal nrm;
PetscViewer view;
PetscBool verbose,FirstBlock=PETSC_FALSE,LastBlock=PETSC_FALSE;
SlepcInitialize(&argc,&argv,(char*)0,help);
ierr = PetscOptionsGetInt(NULL,"-n",&n,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,"-k",&k,NULL);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,"-verbose",&verbose);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Test BV with non-standard inner product (n=%D, k=%D).\n",n,k);CHKERRQ(ierr);
/* Create inner product matrix */
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 = PetscObjectSetName((PetscObject)B,"B");CHKERRQ(ierr);
ierr = MatGetOwnershipRange(B,&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(B,1,&i,3,col,value,INSERT_VALUES);CHKERRQ(ierr);
}
if (LastBlock) {
i=n-1; col[0]=n-2; col[1]=n-1;
ierr = MatSetValues(B,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr);
}
if (FirstBlock) {
i=0; col[0]=0; col[1]=1; value[0]=2.0; value[1]=-1.0;
ierr = MatSetValues(B,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatGetVecs(B,&t,NULL);CHKERRQ(ierr);
/* Create BV object X */
ierr = BVCreate(PETSC_COMM_WORLD,&X);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject)X,"X");CHKERRQ(ierr);
ierr = BVSetSizesFromVec(X,t,k);CHKERRQ(ierr);
ierr = BVSetFromOptions(X);CHKERRQ(ierr);
ierr = BVSetMatrix(X,B,PETSC_FALSE);CHKERRQ(ierr);
/* Set up viewer */
ierr = PetscViewerASCIIGetStdout(PETSC_COMM_WORLD,&view);CHKERRQ(ierr);
if (verbose) {
ierr = PetscViewerPushFormat(view,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
}
/* Fill X entries */
for (j=0;j<k;j++) {
ierr = BVGetColumn(X,j,&v);CHKERRQ(ierr);
ierr = VecZeroEntries(v);CHKERRQ(ierr);
for (i=0;i<4;i++) {
if (i+j<n) {
ierr = VecSetValue(v,i+j,(PetscScalar)(3*i+j-2),INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
ierr = BVRestoreColumn(X,j,&v);CHKERRQ(ierr);
}
if (verbose) {
ierr = MatView(B,view);CHKERRQ(ierr);
ierr = BVView(X,view);CHKERRQ(ierr);
}
/* Test BVNormColumn */
ierr = BVNormColumn(X,0,NORM_2,&nrm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"B-Norm or X[0] = %g\n",(double)nrm);CHKERRQ(ierr);
/* Test BVOrthogonalizeColumn */
for (j=0;j<k;j++) {
ierr = BVOrthogonalizeColumn(X,j,NULL,&nrm,NULL);CHKERRQ(ierr);
alpha = 1.0/nrm;
ierr = BVScaleColumn(X,j,alpha);CHKERRQ(ierr);
}
if (verbose) {
ierr = BVView(X,view);CHKERRQ(ierr);
}
/* Check orthogonality */
ierr = MatCreateSeqDense(PETSC_COMM_SELF,k,k,NULL,&M);CHKERRQ(ierr);
ierr = BVDot(X,X,M);CHKERRQ(ierr);
ierr = MatShift(M,-1.0);CHKERRQ(ierr);
ierr = MatNorm(M,NORM_1,&nrm);CHKERRQ(ierr);
if (nrm<100*PETSC_MACHINE_EPSILON) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"Level of orthogonality < 100*eps\n");CHKERRQ(ierr);
} else {
ierr = PetscPrintf(PETSC_COMM_WORLD,"Level of orthogonality: %g\n",(double)nrm);CHKERRQ(ierr);
}
ierr = BVDestroy(&X);CHKERRQ(ierr);
ierr = MatDestroy(&M);CHKERRQ(ierr);
ierr = MatDestroy(&B);CHKERRQ(ierr);
ierr = VecDestroy(&t);CHKERRQ(ierr);
ierr = SlepcFinalize();
return 0;
}
int main(int argc,char **argv)
{
PetscErrorCode ierr;
Vec t,v;
Mat Q,M;
BV X,Y;
PetscInt i,j,n=10,kx=6,lx=3,ky=5,ly=2;
PetscScalar *q,*z;
PetscReal nrm;
PetscViewer view;
PetscBool verbose,trans;
SlepcInitialize(&argc,&argv,(char*)0,help);
ierr = PetscOptionsGetInt(NULL,"-n",&n,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,"-kx",&kx,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,"-lx",&lx,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,"-ky",&ky,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,"-ly",&ly,NULL);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,"-verbose",&verbose);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"First BV with %D active columns (%D leading columns) of dimension %D.\n",kx,lx,n);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Second BV with %D active columns (%D leading columns) of dimension %D.\n",ky,ly,n);CHKERRQ(ierr);
/* Create template vector */
ierr = VecCreate(PETSC_COMM_WORLD,&t);CHKERRQ(ierr);
ierr = VecSetSizes(t,PETSC_DECIDE,n);CHKERRQ(ierr);
ierr = VecSetFromOptions(t);CHKERRQ(ierr);
/* Create BV object X */
ierr = BVCreate(PETSC_COMM_WORLD,&X);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject)X,"X");CHKERRQ(ierr);
ierr = BVSetSizesFromVec(X,t,kx+2);CHKERRQ(ierr); /* two extra columns to test active columns */
ierr = BVSetFromOptions(X);CHKERRQ(ierr);
ierr = BVSetActiveColumns(X,lx,kx);CHKERRQ(ierr);
/* Set up viewer */
ierr = PetscViewerASCIIGetStdout(PETSC_COMM_WORLD,&view);CHKERRQ(ierr);
if (verbose) {
ierr = PetscViewerPushFormat(view,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
}
/* Fill X entries */
for (j=0;j<kx+2;j++) {
ierr = BVGetColumn(X,j,&v);CHKERRQ(ierr);
ierr = VecZeroEntries(v);CHKERRQ(ierr);
for (i=0;i<4;i++) {
if (i+j<n) {
ierr = VecSetValue(v,i+j,(PetscScalar)(3*i+j-2),INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
ierr = BVRestoreColumn(X,j,&v);CHKERRQ(ierr);
}
if (verbose) {
ierr = BVView(X,view);CHKERRQ(ierr);
}
/* Create BV object Y */
ierr = BVCreate(PETSC_COMM_WORLD,&Y);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject)Y,"Y");CHKERRQ(ierr);
ierr = BVSetSizesFromVec(Y,t,ky+1);CHKERRQ(ierr);
ierr = BVSetFromOptions(Y);CHKERRQ(ierr);
ierr = BVSetActiveColumns(Y,ly,ky);CHKERRQ(ierr);
/* Fill Y entries */
for (j=0;j<ky+1;j++) {
ierr = BVGetColumn(Y,j,&v);CHKERRQ(ierr);
ierr = VecSet(v,(PetscScalar)(j+1)/4.0);CHKERRQ(ierr);
ierr = BVRestoreColumn(Y,j,&v);CHKERRQ(ierr);
}
if (verbose) {
ierr = BVView(Y,view);CHKERRQ(ierr);
}
/* Create Mat */
ierr = MatCreateSeqDense(PETSC_COMM_SELF,kx,ky,NULL,&Q);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject)Q,"Q");CHKERRQ(ierr);
ierr = MatDenseGetArray(Q,&q);CHKERRQ(ierr);
for (i=0;i<kx;i++)
for (j=0;j<ky;j++)
q[i+j*kx] = (i<j)? 2.0: -0.5;
ierr = MatDenseRestoreArray(Q,&q);CHKERRQ(ierr);
if (verbose) {
ierr = MatView(Q,NULL);CHKERRQ(ierr);
}
/* Test BVMult */
ierr = BVMult(Y,2.0,1.0,X,Q);CHKERRQ(ierr);
if (verbose) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"After BVMult - - - - - - - - -\n");CHKERRQ(ierr);
ierr = BVView(Y,view);CHKERRQ(ierr);
}
/* Test BVMultVec */
ierr = BVGetColumn(Y,0,&v);CHKERRQ(ierr);
ierr = PetscMalloc1(kx-lx,&z);CHKERRQ(ierr);
z[0] = 2.0;
for (i=1;i<kx-lx;i++) z[i] = -0.5*z[i-1];
ierr = BVMultVec(X,-1.0,1.0,v,z);CHKERRQ(ierr);
ierr = PetscFree(z);CHKERRQ(ierr);
ierr = BVRestoreColumn(Y,0,&v);CHKERRQ(ierr);
if (verbose) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"After BVMultVec - - - - - - -\n");CHKERRQ(ierr);
ierr = BVView(Y,view);CHKERRQ(ierr);
}
/* Test BVDot */
ierr = MatCreateSeqDense(PETSC_COMM_SELF,ky,kx,NULL,&M);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject)M,"M");CHKERRQ(ierr);
ierr = BVDot(X,Y,M);CHKERRQ(ierr);
if (verbose) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"After BVDot - - - - - - - - -\n");CHKERRQ(ierr);
ierr = MatView(M,NULL);CHKERRQ(ierr);
}
/* Test BVDotVec */
ierr = BVGetColumn(Y,0,&v);CHKERRQ(ierr);
ierr = PetscMalloc1(kx-lx,&z);CHKERRQ(ierr);
ierr = BVDotVec(X,v,z);CHKERRQ(ierr);
ierr = BVRestoreColumn(Y,0,&v);CHKERRQ(ierr);
if (verbose) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"After BVDotVec - - - - - - -\n");CHKERRQ(ierr);
ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,kx-lx,z,&v);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject)v,"z");CHKERRQ(ierr);
ierr = VecView(v,view);CHKERRQ(ierr);
ierr = VecDestroy(&v);CHKERRQ(ierr);
}
ierr = PetscFree(z);CHKERRQ(ierr);
/* Test BVMultInPlace and BVScale */
ierr = PetscOptionsHasName(NULL,"-trans",&trans);CHKERRQ(ierr);
if (trans) {
Mat Qt;
ierr = MatTranspose(Q,MAT_INITIAL_MATRIX,&Qt);CHKERRQ(ierr);
ierr = BVMultInPlaceTranspose(X,Qt,lx+1,ky);CHKERRQ(ierr);
ierr = MatDestroy(&Qt);CHKERRQ(ierr);
} else {
ierr = BVMultInPlace(X,Q,lx+1,ky);CHKERRQ(ierr);
}
ierr = BVScale(X,2.0);CHKERRQ(ierr);
if (verbose) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"After BVMultInPlace - - - - -\n");CHKERRQ(ierr);
ierr = BVView(X,view);CHKERRQ(ierr);
}
/* Test BVNorm */
ierr = BVNormColumn(X,lx,NORM_2,&nrm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"2-Norm or X[%D] = %g\n",lx,(double)nrm);CHKERRQ(ierr);
ierr = BVNorm(X,NORM_FROBENIUS,&nrm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Frobenius Norm or X = %g\n",(double)nrm);CHKERRQ(ierr);
ierr = BVDestroy(&X);CHKERRQ(ierr);
ierr = BVDestroy(&Y);CHKERRQ(ierr);
ierr = MatDestroy(&Q);CHKERRQ(ierr);
ierr = MatDestroy(&M);CHKERRQ(ierr);
ierr = VecDestroy(&t);CHKERRQ(ierr);
ierr = SlepcFinalize();
return 0;
}