Actual source code: default.c

  1: /*
  2:      This file contains some simple default routines for common operations.  
  3: */
 4:  #include src/eps/epsimpl.h
 5:  #include slepcblaslapack.h

  9: PetscErrorCode EPSDestroy_Default(EPS eps)
 10: {

 15:   PetscFree(eps->data);

 17:   /* free work vectors */
 18:   EPSDefaultFreeWork(eps);
 19:   EPSFreeSolution(eps);
 20:   return(0);
 21: }

 25: PetscErrorCode EPSBackTransform_Default(EPS eps)
 26: {
 28:   int            i;

 32:   for (i=0;i<eps->nconv;i++) {
 33:     STBackTransform(eps->OP,&eps->eigr[i],&eps->eigi[i]);
 34:   }
 35:   return(0);
 36: }

 40: /*
 41:   EPSComputeVectors_Default - Compute eigenvectors from the vectors
 42:   provided by the eigensolver. This version just copies the vectors
 43:   and is intended for solvers such as power that provide the eigenvector.
 44:  */
 45: PetscErrorCode EPSComputeVectors_Default(EPS eps)
 46: {
 48:   int            i;

 51:   for (i=0;i<eps->nconv;i++) {
 52:     VecCopy(eps->V[i],eps->AV[i]);
 53:     if (eps->solverclass == EPS_TWO_SIDE) {
 54:       VecCopy(eps->W[i],eps->AW[i]);
 55:     }
 56:   }
 57:   eps->evecsavailable = PETSC_TRUE;
 58:   return(0);
 59: }

 63: /*
 64:   EPSComputeVectors_Schur - Compute eigenvectors from the vectors
 65:   provided by the eigensolver. This version is intended for solvers 
 66:   that provide Schur vectors. Given the partial Schur decomposition
 67:   OP*V=V*T, the following steps are performed:
 68:       1) compute eigenvectors of T: T*Z=Z*D
 69:       2) compute eigenvectors of OP: X=V*Z
 70:   If left eigenvectors are required then also do Z'*Tl=D*Z', Y=W*Z
 71:  */
 72: PetscErrorCode EPSComputeVectors_Schur(EPS eps)
 73: {
 74: #if defined(SLEPC_MISSING_LAPACK_TREVC)
 75:   SETERRQ(PETSC_ERR_SUP,"TREVC - Lapack routine is unavailable.");
 76: #else
 78:   int            i,mout,info,nv=eps->nv;
 79:   PetscScalar    *Z,*work;
 80: #if defined(PETSC_USE_COMPLEX)
 81:   PetscReal      *rwork;
 82: #endif
 83: 
 85:   if (eps->ishermitian) {
 86:     EPSComputeVectors_Default(eps);
 87:     return(0);
 88:   }

 90:   PetscMalloc(nv*nv*sizeof(PetscScalar),&Z);
 91:   PetscMalloc(3*nv*sizeof(PetscScalar),&work);
 92: #if defined(PETSC_USE_COMPLEX)
 93:   PetscMalloc(nv*sizeof(PetscReal),&rwork);
 94: #endif

 96:   /* right eigenvectors */
 97: #if !defined(PETSC_USE_COMPLEX)
 98:   LAPACKtrevc_("R","A",PETSC_NULL,&nv,eps->T,&eps->ncv,PETSC_NULL,&nv,Z,&nv,&nv,&mout,work,&info,1,1);
 99: #else
100:   LAPACKtrevc_("R","A",PETSC_NULL,&nv,eps->T,&eps->ncv,PETSC_NULL,&nv,Z,&nv,&nv,&mout,work,rwork,&info,1,1);
101: #endif
102:   if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack xTREVC %i",info);

104:   /* AV = V * Z */
105:   for (i=0;i<eps->nconv;i++) {
106:     VecSet(eps->AV[i],0.0);
107:     VecMAXPY(eps->AV[i],nv,Z+nv*i,eps->V);
108:   }
109: 
110:   /* left eigenvectors */
111:   if (eps->solverclass == EPS_TWO_SIDE) {
112: #if !defined(PETSC_USE_COMPLEX)
113:     LAPACKtrevc_("R","A",PETSC_NULL,&nv,eps->Tl,&eps->nv,PETSC_NULL,&nv,Z,&nv,&nv,&mout,work,&info,1,1);
114: #else
115:     LAPACKtrevc_("R","A",PETSC_NULL,&nv,eps->Tl,&eps->nv,PETSC_NULL,&nv,Z,&nv,&nv,&mout,work,rwork,&info,1,1);
116: #endif
117:     if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack xTREVC %i",info);

119:     /* AW = W * Z */
120:     for (i=0;i<eps->nconv;i++) {
121:       VecSet(eps->AW[i],0.0);
122:       VecMAXPY(eps->AW[i],nv,Z+nv*i,eps->W);
123:     }
124:   }
125: 
126:   PetscFree(Z);
127:   PetscFree(work);
128: #if defined(PETSC_USE_COMPLEX)
129:   PetscFree(rwork);
130: #endif
131:   eps->evecsavailable = PETSC_TRUE;
132:   return(0);
133: #endif 
134: }

138: /*
139:   EPSDefaultGetWork - Gets a number of work vectors.

141:   Input Parameters:
142: + eps  - eigensolver context
143: - nw   - number of work vectors to allocate

145:   Notes:
146:   Call this only if no work vectors have been allocated.

148:  */
149: PetscErrorCode EPSDefaultGetWork(EPS eps, int nw)
150: {


155:   if (eps->nwork != nw) {
156:     if (eps->nwork > 0) {
157:       VecDestroyVecs(eps->work,eps->nwork);
158:     }
159:     eps->nwork = nw;
160:     VecDuplicateVecs(eps->vec_initial,nw,&eps->work);
161:     PetscLogObjectParents(eps,nw,eps->work);
162:   }
163: 
164:   return(0);
165: }

169: /*
170:   EPSDefaultFreeWork - Free work vectors.

172:   Input Parameters:
173: . eps  - eigensolver context

175:  */
176: PetscErrorCode EPSDefaultFreeWork(EPS eps)
177: {

182:   if (eps->work)  {
183:     VecDestroyVecs(eps->work,eps->nwork);
184:   }
185:   return(0);
186: }