/*
EPSComputeResidualNorm_Private - Computes the norm of the residual vector
associated with an eigenpair.
*/
PetscErrorCode EPSComputeResidualNorm_Private(EPS eps,PetscScalar kr,PetscScalar ki,Vec xr,Vec xi,PetscReal *norm)
{
PetscErrorCode ierr;
PetscInt nmat;
Vec u,w;
Mat A,B;
#if !defined(PETSC_USE_COMPLEX)
Vec v;
PetscReal ni,nr;
#endif
PetscFunctionBegin;
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); }
ierr = BVGetVec(eps->V,&u);CHKERRQ(ierr);
ierr = BVGetVec(eps->V,&w);CHKERRQ(ierr);
#if !defined(PETSC_USE_COMPLEX)
if (ki == 0 || PetscAbsScalar(ki) < PetscAbsScalar(kr*PETSC_MACHINE_EPSILON)) {
#endif
ierr = MatMult(A,xr,u);CHKERRQ(ierr); /* u=A*x */
if (PetscAbsScalar(kr) > PETSC_MACHINE_EPSILON) {
if (eps->isgeneralized) { ierr = MatMult(B,xr,w);CHKERRQ(ierr); }
else { ierr = VecCopy(xr,w);CHKERRQ(ierr); } /* w=B*x */
ierr = VecAXPY(u,-kr,w);CHKERRQ(ierr); /* u=A*x-k*B*x */
}
ierr = VecNorm(u,NORM_2,norm);CHKERRQ(ierr);
#if !defined(PETSC_USE_COMPLEX)
} else {
ierr = BVGetVec(eps->V,&v);CHKERRQ(ierr);
ierr = MatMult(A,xr,u);CHKERRQ(ierr); /* u=A*xr */
if (SlepcAbsEigenvalue(kr,ki) > PETSC_MACHINE_EPSILON) {
if (eps->isgeneralized) { ierr = MatMult(B,xr,v);CHKERRQ(ierr); }
else { ierr = VecCopy(xr,v);CHKERRQ(ierr); } /* v=B*xr */
ierr = VecAXPY(u,-kr,v);CHKERRQ(ierr); /* u=A*xr-kr*B*xr */
if (eps->isgeneralized) { ierr = MatMult(B,xi,w);CHKERRQ(ierr); }
else { ierr = VecCopy(xi,w);CHKERRQ(ierr); } /* w=B*xi */
ierr = VecAXPY(u,ki,w);CHKERRQ(ierr); /* u=A*xr-kr*B*xr+ki*B*xi */
}
ierr = VecNorm(u,NORM_2,&nr);CHKERRQ(ierr);
ierr = MatMult(A,xi,u);CHKERRQ(ierr); /* u=A*xi */
if (SlepcAbsEigenvalue(kr,ki) > PETSC_MACHINE_EPSILON) {
ierr = VecAXPY(u,-kr,w);CHKERRQ(ierr); /* u=A*xi-kr*B*xi */
ierr = VecAXPY(u,-ki,v);CHKERRQ(ierr); /* u=A*xi-kr*B*xi-ki*B*xr */
}
ierr = VecNorm(u,NORM_2,&ni);CHKERRQ(ierr);
*norm = SlepcAbsEigenvalue(nr,ni);
ierr = VecDestroy(&v);CHKERRQ(ierr);
}
#endif
ierr = VecDestroy(&w);CHKERRQ(ierr);
ierr = VecDestroy(&u);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
Function for user-defined eigenvalue ordering criterion.
Given two eigenvalues ar+i*ai and br+i*bi, the subroutine must choose
one of them as the preferred one according to the criterion.
In this example, the preferred value is the one furthest to the origin.
*/
PetscErrorCode MyEigenSort(PetscScalar ar,PetscScalar ai,PetscScalar br,PetscScalar bi,PetscInt *r,void *ctx)
{
PetscScalar origin = *(PetscScalar*)ctx;
PetscReal d;
PetscFunctionBeginUser;
d = (SlepcAbsEigenvalue(br-origin,bi) - SlepcAbsEigenvalue(ar-origin,ai))/PetscMax(SlepcAbsEigenvalue(ar-origin,ai),SlepcAbsEigenvalue(br-origin,bi));
*r = d > PETSC_SQRT_MACHINE_EPSILON ? 1 : (d < -PETSC_SQRT_MACHINE_EPSILON ? -1 : PetscSign(PetscRealPart(br)));
PetscFunctionReturn(0);
}
/*
PEPConvergedNormRelative - Checks convergence relative to the matrix norms.
*/
PetscErrorCode PEPConvergedNormRelative(PEP pep,PetscScalar eigr,PetscScalar eigi,PetscReal res,PetscReal *errest,void *ctx)
{
PetscErrorCode ierr;
PetscInt i;
PetscReal w=0.0;
PetscScalar t[20],*vals=t,*ivals=NULL;
#if !defined(PETSC_USE_COMPLEX)
PetscScalar it[20];
#endif
PetscFunctionBegin;
#if !defined(PETSC_USE_COMPLEX)
ivals = it;
#endif
if (pep->nmat>20) {
#if !defined(PETSC_USE_COMPLEX)
ierr = PetscMalloc2(pep->nmat,&vals,pep->nmat,&ivals);CHKERRQ(ierr);
#else
ierr = PetscMalloc1(pep->nmat,&vals);CHKERRQ(ierr);
#endif
}
ierr = PEPEvaluateBasis(pep,eigr,eigi,vals,ivals);CHKERRQ(ierr);
for (i=0;i<pep->nmat;i++) w += SlepcAbsEigenvalue(vals[i],ivals[i])*pep->nrma[i];
*errest = res/w;
if (pep->nmat>20) {
#if !defined(PETSC_USE_COMPLEX)
ierr = PetscFree2(vals,ivals);CHKERRQ(ierr);
#else
ierr = PetscFree(vals);CHKERRQ(ierr);
#endif
}
PetscFunctionReturn(0);
}
/*
EPSComputeRelativeError_Private - Computes the relative error bound
associated with an eigenpair.
*/
PetscErrorCode EPSComputeRelativeError_Private(EPS eps,PetscScalar kr,PetscScalar ki,Vec xr,Vec xi,PetscReal *error)
{
PetscErrorCode ierr;
PetscReal norm,er;
#if !defined(PETSC_USE_COMPLEX)
PetscReal ei;
#endif
PetscFunctionBegin;
ierr = EPSComputeResidualNorm_Private(eps,kr,ki,xr,xi,&norm);CHKERRQ(ierr);
#if !defined(PETSC_USE_COMPLEX)
if (ki == 0) {
#endif
ierr = VecNorm(xr,NORM_2,&er);CHKERRQ(ierr);
#if !defined(PETSC_USE_COMPLEX)
} else {
ierr = VecNorm(xr,NORM_2,&er);CHKERRQ(ierr);
ierr = VecNorm(xi,NORM_2,&ei);CHKERRQ(ierr);
er = SlepcAbsEigenvalue(er,ei);
}
#endif
ierr = (*eps->converged)(eps,kr,ki,norm/er,error,eps->convergedctx);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
PEPConvergedEigRelative - Checks convergence relative to the eigenvalue.
*/
PetscErrorCode PEPConvergedEigRelative(PEP pep,PetscScalar eigr,PetscScalar eigi,PetscReal res,PetscReal *errest,void *ctx)
{
PetscReal w;
PetscFunctionBegin;
w = SlepcAbsEigenvalue(eigr,eigi);
*errest = res/w;
PetscFunctionReturn(0);
}
/*
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 DSNormalize_NHEP(DS ds,DSMatType mat,PetscInt col)
{
PetscErrorCode ierr;
PetscInt i,i0,i1;
PetscBLASInt ld,n,one = 1;
PetscScalar *A = ds->mat[DS_MAT_A],norm,*x;
#if !defined(PETSC_USE_COMPLEX)
PetscScalar norm0;
#endif
PetscFunctionBegin;
switch (mat) {
case DS_MAT_X:
case DS_MAT_Y:
case DS_MAT_Q:
/* Supported matrices */
break;
case DS_MAT_U:
case DS_MAT_VT:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented yet");
break;
default:
SETERRQ(PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_OUTOFRANGE,"Invalid mat parameter");
}
ierr = PetscBLASIntCast(ds->n,&n);CHKERRQ(ierr);
ierr = PetscBLASIntCast(ds->ld,&ld);CHKERRQ(ierr);
ierr = DSGetArray(ds,mat,&x);CHKERRQ(ierr);
if (col < 0) {
i0 = 0; i1 = ds->n;
} else if (col>0 && A[ds->ld*(col-1)+col] != 0.0) {
i0 = col-1; i1 = col+1;
} else {
i0 = col; i1 = col+1;
}
for (i=i0;i<i1;i++) {
#if !defined(PETSC_USE_COMPLEX)
if (i<n-1 && A[ds->ld*i+i+1] != 0.0) {
norm = BLASnrm2_(&n,&x[ld*i],&one);
norm0 = BLASnrm2_(&n,&x[ld*(i+1)],&one);
norm = 1.0/SlepcAbsEigenvalue(norm,norm0);
PetscStackCallBLAS("BLASscal",BLASscal_(&n,&norm,&x[ld*i],&one));
PetscStackCallBLAS("BLASscal",BLASscal_(&n,&norm,&x[ld*(i+1)],&one));
i++;
} else
#endif
{
norm = BLASnrm2_(&n,&x[ld*i],&one);
norm = 1.0/norm;
PetscStackCallBLAS("BLASscal",BLASscal_(&n,&norm,&x[ld*i],&one));
}
}
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);
}
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);
}
/*
PEPComputeResidualNorm_Private - Computes the norm of the residual vector
associated with an eigenpair.
*/
PetscErrorCode PEPComputeResidualNorm_Private(PEP pep,PetscScalar kr,PetscScalar ki,Vec xr,Vec xi,PetscReal *norm)
{
PetscErrorCode ierr;
Vec u,w;
Mat *A=pep->A;
PetscInt i,nmat=pep->nmat;
PetscScalar t[20],*vals=t,*ivals=NULL;
#if !defined(PETSC_USE_COMPLEX)
Vec ui,wi;
PetscReal ni;
PetscBool imag;
PetscScalar it[20];
#endif
PetscFunctionBegin;
ierr = BVGetVec(pep->V,&u);CHKERRQ(ierr);
ierr = BVGetVec(pep->V,&w);CHKERRQ(ierr);
ierr = VecZeroEntries(u);CHKERRQ(ierr);
#if !defined(PETSC_USE_COMPLEX)
ivals = it;
#endif
if (nmat>20) {
ierr = PetscMalloc(nmat*sizeof(PetscScalar),&vals);CHKERRQ(ierr);
#if !defined(PETSC_USE_COMPLEX)
ierr = PetscMalloc(nmat*sizeof(PetscScalar),&ivals);CHKERRQ(ierr);
#endif
}
ierr = PEPEvaluateBasis(pep,kr,ki,vals,ivals);CHKERRQ(ierr);
#if !defined(PETSC_USE_COMPLEX)
if (ki == 0 || PetscAbsScalar(ki) < PetscAbsScalar(kr*PETSC_MACHINE_EPSILON))
imag = PETSC_FALSE;
else {
imag = PETSC_TRUE;
ierr = VecDuplicate(u,&ui);CHKERRQ(ierr);
ierr = VecDuplicate(u,&wi);CHKERRQ(ierr);
ierr = VecZeroEntries(ui);CHKERRQ(ierr);
}
#endif
for (i=0;i<nmat;i++) {
if (vals[i]!=0.0) {
ierr = MatMult(A[i],xr,w);CHKERRQ(ierr);
ierr = VecAXPY(u,vals[i],w);CHKERRQ(ierr);
}
#if !defined(PETSC_USE_COMPLEX)
if (imag) {
if (ivals[i]!=0 || vals[i]!=0) {
ierr = MatMult(A[i],xi,wi);CHKERRQ(ierr);
if (vals[i]==0) {
ierr = MatMult(A[i],xr,w);CHKERRQ(ierr);
}
}
if (ivals[i]!=0){
ierr = VecAXPY(u,-ivals[i],wi);CHKERRQ(ierr);
ierr = VecAXPY(ui,ivals[i],w);CHKERRQ(ierr);
}
if (vals[i]!=0) {
ierr = VecAXPY(ui,vals[i],wi);CHKERRQ(ierr);
}
}
#endif
}
ierr = VecNorm(u,NORM_2,norm);CHKERRQ(ierr);
#if !defined(PETSC_USE_COMPLEX)
if (imag) {
ierr = VecNorm(ui,NORM_2,&ni);CHKERRQ(ierr);
*norm = SlepcAbsEigenvalue(*norm,ni);
}
#endif
ierr = VecDestroy(&w);CHKERRQ(ierr);
ierr = VecDestroy(&u);CHKERRQ(ierr);
if (nmat>20) {
ierr = PetscFree(vals);CHKERRQ(ierr);
#if !defined(PETSC_USE_COMPLEX)
ierr = PetscFree(ivals);CHKERRQ(ierr);
#endif
}
#if !defined(PETSC_USE_COMPLEX)
if (imag) {
ierr = VecDestroy(&wi);CHKERRQ(ierr);
ierr = VecDestroy(&ui);CHKERRQ(ierr);
}
#endif
PetscFunctionReturn(0);
}
PetscErrorCode DSVectors_NHEP_Eigen_Some(DS ds,PetscInt *k,PetscReal *rnorm,PetscBool left)
{
#if defined(SLEPC_MISSING_LAPACK_TREVC)
PetscFunctionBegin;
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"TREVC - Lapack routine is unavailable");
#else
PetscErrorCode ierr;
PetscInt i;
PetscBLASInt mm=1,mout,info,ld,n,inc = 1;
PetscScalar tmp,done=1.0,zero=0.0;
PetscReal norm;
PetscBool iscomplex = PETSC_FALSE;
PetscBLASInt *select;
PetscScalar *A = ds->mat[DS_MAT_A];
PetscScalar *Q = ds->mat[DS_MAT_Q];
PetscScalar *X = ds->mat[left?DS_MAT_Y:DS_MAT_X];
PetscScalar *Y;
PetscFunctionBegin;
ierr = PetscBLASIntCast(ds->n,&n);CHKERRQ(ierr);
ierr = PetscBLASIntCast(ds->ld,&ld);CHKERRQ(ierr);
ierr = DSAllocateWork_Private(ds,0,0,ld);CHKERRQ(ierr);
select = ds->iwork;
for (i=0;i<n;i++) select[i] = (PetscBLASInt)PETSC_FALSE;
/* Compute k-th eigenvector Y of A */
Y = X+(*k)*ld;
select[*k] = (PetscBLASInt)PETSC_TRUE;
#if !defined(PETSC_USE_COMPLEX)
if ((*k)<n-1 && A[(*k)+1+(*k)*ld]!=0.0) iscomplex = PETSC_TRUE;
mm = iscomplex? 2: 1;
if (iscomplex) select[(*k)+1] = (PetscBLASInt)PETSC_TRUE;
ierr = DSAllocateWork_Private(ds,3*ld,0,0);CHKERRQ(ierr);
PetscStackCallBLAS("LAPACKtrevc",LAPACKtrevc_(left?"L":"R","S",select,&n,A,&ld,Y,&ld,Y,&ld,&mm,&mout,ds->work,&info));
#else
ierr = DSAllocateWork_Private(ds,2*ld,ld,0);CHKERRQ(ierr);
PetscStackCallBLAS("LAPACKtrevc",LAPACKtrevc_(left?"L":"R","S",select,&n,A,&ld,Y,&ld,Y,&ld,&mm,&mout,ds->work,ds->rwork,&info));
#endif
if (info) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in Lapack xTREVC %d",info);
if (mout != mm) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Inconsistent arguments");
/* accumulate and normalize eigenvectors */
if (ds->state>=DS_STATE_CONDENSED) {
ierr = PetscMemcpy(ds->work,Y,mout*ld*sizeof(PetscScalar));CHKERRQ(ierr);
PetscStackCallBLAS("BLASgemv",BLASgemv_("N",&n,&n,&done,Q,&ld,ds->work,&inc,&zero,Y,&inc));
#if !defined(PETSC_USE_COMPLEX)
if (iscomplex) PetscStackCallBLAS("BLASgemv",BLASgemv_("N",&n,&n,&done,Q,&ld,ds->work+ld,&inc,&zero,Y+ld,&inc));
#endif
norm = BLASnrm2_(&n,Y,&inc);
#if !defined(PETSC_USE_COMPLEX)
if (iscomplex) {
tmp = BLASnrm2_(&n,Y+ld,&inc);
norm = SlepcAbsEigenvalue(norm,tmp);
}
#endif
tmp = 1.0 / norm;
PetscStackCallBLAS("BLASscal",BLASscal_(&n,&tmp,Y,&inc));
#if !defined(PETSC_USE_COMPLEX)
if (iscomplex) PetscStackCallBLAS("BLASscal",BLASscal_(&n,&tmp,Y+ld,&inc));
#endif
}
/* set output arguments */
if (iscomplex) (*k)++;
if (rnorm) {
if (iscomplex) *rnorm = SlepcAbsEigenvalue(Y[n-1],Y[n-1+ld]);
else *rnorm = PetscAbsScalar(Y[n-1]);
}
PetscFunctionReturn(0);
#endif
}
