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: }