/*
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);
}
/*
Custom CGS orthogonalization, preprocess after first orthogonalization
*/
static PetscErrorCode SVDOrthogonalizeCGS(BV V,PetscInt i,PetscScalar* h,PetscReal a,BVOrthogRefineType refine,PetscReal eta,PetscReal *norm)
{
PetscErrorCode ierr;
PetscReal sum,onorm;
PetscScalar dot;
PetscInt j;
PetscFunctionBegin;
switch (refine) {
case BV_ORTHOG_REFINE_NEVER:
ierr = BVNormColumn(V,i,NORM_2,norm);CHKERRQ(ierr);
break;
case BV_ORTHOG_REFINE_ALWAYS:
ierr = BVSetActiveColumns(V,0,i);CHKERRQ(ierr);
ierr = BVDotColumn(V,i,h);CHKERRQ(ierr);
ierr = BVMultColumn(V,-1.0,1.0,i,h);CHKERRQ(ierr);
ierr = BVNormColumn(V,i,NORM_2,norm);CHKERRQ(ierr);
break;
case BV_ORTHOG_REFINE_IFNEEDED:
dot = h[i];
onorm = PetscSqrtReal(PetscRealPart(dot)) / a;
sum = 0.0;
for (j=0;j<i;j++) {
sum += PetscRealPart(h[j] * PetscConj(h[j]));
}
*norm = PetscRealPart(dot)/(a*a) - sum;
if (*norm>0.0) *norm = PetscSqrtReal(*norm);
else {
ierr = BVNormColumn(V,i,NORM_2,norm);CHKERRQ(ierr);
}
if (*norm < eta*onorm) {
ierr = BVSetActiveColumns(V,0,i);CHKERRQ(ierr);
ierr = BVDotColumn(V,i,h);CHKERRQ(ierr);
ierr = BVMultColumn(V,-1.0,1.0,i,h);CHKERRQ(ierr);
ierr = BVNormColumn(V,i,NORM_2,norm);CHKERRQ(ierr);
}
break;
}
PetscFunctionReturn(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);
}
