Actual source code: qarnoldi.c
1: /*
3: Q-Arnoldi method for quadratic eigenproblems.
5: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
6: SLEPc - Scalable Library for Eigenvalue Problem Computations
7: Copyright (c) 2002-2011, Universitat Politecnica de Valencia, Spain
9: This file is part of SLEPc.
10:
11: SLEPc is free software: you can redistribute it and/or modify it under the
12: terms of version 3 of the GNU Lesser General Public License as published by
13: the Free Software Foundation.
15: SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY
16: WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
17: FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for
18: more details.
20: You should have received a copy of the GNU Lesser General Public License
21: along with SLEPc. If not, see <http://www.gnu.org/licenses/>.
22: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
23: */
25: #include <private/qepimpl.h> /*I "slepcqep.h" I*/
26: #include <petscblaslapack.h>
28: typedef struct {
29: KSP ksp;
30: } QEP_QARNOLDI;
34: PetscErrorCode QEPSetUp_QArnoldi(QEP qep)
35: {
37: QEP_QARNOLDI *ctx = (QEP_QARNOLDI*)qep->data;
38:
40: if (qep->ncv) { /* ncv set */
41: if (qep->ncv<qep->nev) SETERRQ(((PetscObject)qep)->comm,1,"The value of ncv must be at least nev");
42: }
43: else if (qep->mpd) { /* mpd set */
44: qep->ncv = PetscMin(qep->n,qep->nev+qep->mpd);
45: }
46: else { /* neither set: defaults depend on nev being small or large */
47: if (qep->nev<500) qep->ncv = PetscMin(qep->n,PetscMax(2*qep->nev,qep->nev+15));
48: else { qep->mpd = 500; qep->ncv = PetscMin(qep->n,qep->nev+qep->mpd); }
49: }
50: if (!qep->mpd) qep->mpd = qep->ncv;
51: if (qep->ncv>qep->nev+qep->mpd) SETERRQ(((PetscObject)qep)->comm,1,"The value of ncv must not be larger than nev+mpd");
52: if (!qep->max_it) qep->max_it = PetscMax(100,2*qep->n/qep->ncv);
53: if (!qep->which) qep->which = QEP_LARGEST_MAGNITUDE;
54: if (qep->problem_type != QEP_GENERAL)
55: SETERRQ(((PetscObject)qep)->comm,1,"Wrong value of qep->problem_type");
57: QEPAllocateSolution(qep);
58: PetscFree(qep->T);
59: PetscMalloc(qep->ncv*qep->ncv*sizeof(PetscScalar),&qep->T);
60: QEPDefaultGetWork(qep,4);
62: KSPSetOperators(ctx->ksp,qep->M,qep->M,DIFFERENT_NONZERO_PATTERN);
63: KSPSetUp(ctx->ksp);
64: return(0);
65: }
69: /*
70: Compute a step of Classical Gram-Schmidt orthogonalization
71: */
72: PetscErrorCode QEPQArnoldiCGS(QEP qep,PetscScalar *H,PetscBLASInt ldh,PetscScalar *h,PetscBLASInt j,Vec *V,Vec t,Vec v,Vec w,PetscReal *onorm,PetscReal *norm,PetscScalar *work)
73: {
75: PetscBLASInt ione = 1,j_1 = j+1;
76: PetscReal x,y;
77: PetscScalar dot,one = 1.0,zero = 0.0;
80: /* compute norm of v and w */
81: if (onorm) {
82: VecNorm(v,NORM_2,&x);
83: VecNorm(w,NORM_2,&y);
84: *onorm = PetscSqrtReal(x*x+y*y);
85: }
87: /* orthogonalize: compute h */
88: VecMDot(v,j_1,V,h);
89: VecMDot(w,j_1,V,work);
90: if (j>0)
91: BLASgemv_("C",&j_1,&j,&one,H,&ldh,work,&ione,&one,h,&ione);
92: VecDot(t,w,&dot);
93: h[j] += dot;
95: /* orthogonalize: update v and w */
96: SlepcVecMAXPBY(v,1.0,-1.0,j_1,h,V);
97: if (j>0) {
98: BLASgemv_("N",&j_1,&j,&one,H,&ldh,h,&ione,&zero,work,&ione);
99: SlepcVecMAXPBY(w,1.0,-1.0,j_1,work,V);
100: }
101: VecAXPY(w,-h[j],t);
102:
103: /* compute norm of v and w */
104: if (norm) {
105: VecNorm(v,NORM_2,&x);
106: VecNorm(w,NORM_2,&y);
107: *norm = PetscSqrtReal(x*x+y*y);
108: }
109: return(0);
110: }
114: /*
115: Compute a run of Q-Arnoldi iterations
116: */
117: PetscErrorCode QEPQArnoldi(QEP qep,PetscScalar *H,PetscInt ldh,Vec *V,PetscInt k,PetscInt *M,Vec v,Vec w,PetscReal *beta,PetscBool *breakdown,PetscScalar *work)
118: {
119: PetscErrorCode ierr;
120: PetscInt i,j,l,m = *M;
121: QEP_QARNOLDI *ctx = (QEP_QARNOLDI*)qep->data;
122: Vec t = qep->work[2],u = qep->work[3];
123: IPOrthogRefineType refinement;
124: PetscReal norm,onorm,eta;
125: PetscScalar *c = work + m;
128: IPGetOrthogonalization(qep->ip,PETSC_NULL,&refinement,&eta);
129: VecCopy(v,qep->V[k]);
130:
131: for (j=k;j<m;j++) {
132: /* apply operator */
133: VecCopy(w,t);
134: MatMult(qep->K,v,u);
135: MatMult(qep->C,t,w);
136: VecAXPY(u,qep->sfactor,w);
137: KSPSolve(ctx->ksp,u,w);
138: VecScale(w,-1.0/(qep->sfactor*qep->sfactor));
139: VecCopy(t,v);
141: /* orthogonalize */
142: switch (refinement) {
143: case IP_ORTHOG_REFINE_NEVER:
144: QEPQArnoldiCGS(qep,H,ldh,H+ldh*j,j,V,t,v,w,PETSC_NULL,&norm,work);
145: *breakdown = PETSC_FALSE;
146: break;
147: case IP_ORTHOG_REFINE_ALWAYS:
148: QEPQArnoldiCGS(qep,H,ldh,H+ldh*j,j,V,t,v,w,PETSC_NULL,PETSC_NULL,work);
149: QEPQArnoldiCGS(qep,H,ldh,c,j,V,t,v,w,&onorm,&norm,work);
150: for (i=0;i<j;i++) H[ldh*j+i] += c[i];
151: if (norm < eta * onorm) *breakdown = PETSC_TRUE;
152: else *breakdown = PETSC_FALSE;
153: break;
154: case IP_ORTHOG_REFINE_IFNEEDED:
155: QEPQArnoldiCGS(qep,H,ldh,H+ldh*j,j,V,t,v,w,&onorm,&norm,work);
156: /* ||q|| < eta ||h|| */
157: l = 1;
158: while (l<3 && norm < eta * onorm) {
159: l++;
160: onorm = norm;
161: QEPQArnoldiCGS(qep,H,ldh,c,j,V,t,v,w,PETSC_NULL,&norm,work);
162: for (i=0;i<j;i++) H[ldh*j+i] += c[i];
163: }
164: if (norm < eta * onorm) *breakdown = PETSC_TRUE;
165: else *breakdown = PETSC_FALSE;
166: break;
167: default: SETERRQ(((PetscObject)qep)->comm,1,"Wrong value of ip->orth_ref");
168: }
169: VecScale(v,1.0/norm);
170: VecScale(w,1.0/norm);
171:
172: if (j<m-1) {
173: H[j+1+ldh*j] = norm;
174: VecCopy(v,V[j+1]);
175: }
176: }
177: *beta = norm;
178: return(0);
179: }
183: /*
184: QEPProjectedKSNonsym - Solves the projected eigenproblem in the Krylov-Schur
185: method (non-symmetric case).
187: On input:
188: l is the number of vectors kept in previous restart (0 means first restart)
189: S is the projected matrix (leading dimension is lds)
191: On output:
192: S has (real) Schur form with diagonal blocks sorted appropriately
193: Q contains the corresponding Schur vectors (order n, leading dimension n)
194: */
195: PetscErrorCode QEPProjectedKSNonsym(QEP qep,PetscInt l,PetscScalar *S,PetscInt lds,PetscScalar *Q,PetscInt n)
196: {
198: PetscInt i;
201: if (l==0) {
202: PetscMemzero(Q,n*n*sizeof(PetscScalar));
203: for (i=0;i<n;i++)
204: Q[i*(n+1)] = 1.0;
205: } else {
206: /* Reduce S to Hessenberg form, S <- Q S Q' */
207: EPSDenseHessenberg(n,qep->nconv,S,lds,Q);
208: }
209: /* Reduce S to (quasi-)triangular form, S <- Q S Q' */
210: EPSDenseSchur(n,qep->nconv,S,lds,Q,qep->eigr,qep->eigi);
211: /* Sort the remaining columns of the Schur form */
212: QEPSortDenseSchur(qep,n,qep->nconv,S,lds,Q,qep->eigr,qep->eigi);
213: return(0);
214: }
218: PetscErrorCode QEPSolve_QArnoldi(QEP qep)
219: {
221: PetscInt i,j,k,l,lwork,nv;
222: Vec v=qep->work[0],w=qep->work[1];
223: PetscScalar *S=qep->T,*Q,*work;
224: PetscReal beta,norm,x,y;
225: PetscBool breakdown;
228: PetscMemzero(S,qep->ncv*qep->ncv*sizeof(PetscScalar));
229: PetscMalloc(qep->ncv*qep->ncv*sizeof(PetscScalar),&Q);
230: lwork = 7*qep->ncv;
231: PetscMalloc(lwork*sizeof(PetscScalar),&work);
233: /* Get the starting Arnoldi vector */
234: if (qep->nini>0) {
235: VecCopy(qep->V[0],v);
236: } else {
237: SlepcVecSetRandom(v,qep->rand);
238: }
239: /* w is always a random vector */
240: SlepcVecSetRandom(w,qep->rand);
241: VecNorm(v,NORM_2,&x);
242: VecNorm(w,NORM_2,&y);
243: norm = PetscSqrtReal(x*x+y*y);
244: VecScale(v,1.0/norm);
245: VecScale(w,1.0/norm);
246:
247: /* Restart loop */
248: l = 0;
249: while (qep->reason == QEP_CONVERGED_ITERATING) {
250: qep->its++;
252: /* Compute an nv-step Arnoldi factorization */
253: nv = PetscMin(qep->nconv+qep->mpd,qep->ncv);
254: QEPQArnoldi(qep,S,qep->ncv,qep->V,qep->nconv+l,&nv,v,w,&beta,&breakdown,work);
256: /* Solve projected problem */
257: QEPProjectedKSNonsym(qep,l,S,qep->ncv,Q,nv);
259: /* Check convergence */
260: QEPKrylovConvergence(qep,qep->nconv,nv-qep->nconv,S,qep->ncv,Q,nv,beta,&k,work);
261: if (qep->its >= qep->max_it) qep->reason = QEP_DIVERGED_ITS;
262: if (k >= qep->nev) qep->reason = QEP_CONVERGED_TOL;
263:
264: /* Update l */
265: if (qep->reason != QEP_CONVERGED_ITERATING || breakdown) l = 0;
266: else {
267: l = (nv-k)/2;
268: #if !defined(PETSC_USE_COMPLEX)
269: if (S[(k+l-1)*(qep->ncv+1)+1] != 0.0) {
270: if (k+l<nv-1) l = l+1;
271: else l = l-1;
272: }
273: #endif
274: }
276: if (qep->reason == QEP_CONVERGED_ITERATING) {
277: if (breakdown) {
278: /* Stop if breakdown */
279: PetscInfo2(qep,"Breakdown Quadratic Arnoldi method (it=%D norm=%G)\n",qep->its,beta);
280: qep->reason = QEP_DIVERGED_BREAKDOWN;
281: } else {
282: /* Prepare the Rayleigh quotient for restart */
283: for (i=k;i<k+l;i++) {
284: S[i*qep->ncv+k+l] = Q[(i+1)*nv-1]*beta;
285: }
286: }
287: }
288: /* Update the corresponding vectors V(:,idx) = V*Q(:,idx) */
289: SlepcUpdateVectors(nv,qep->V,qep->nconv,k+l,Q,nv,PETSC_FALSE);
291: qep->nconv = k;
292: QEPMonitor(qep,qep->its,qep->nconv,qep->eigr,qep->eigi,qep->errest,nv);
293: }
295: for (j=0;j<qep->nconv;j++) {
296: qep->eigr[j] *= qep->sfactor;
297: qep->eigi[j] *= qep->sfactor;
298: }
300: /* Compute eigenvectors */
301: if (qep->nconv > 0) {
302: QEPComputeVectors_Schur(qep);
303: }
305: PetscFree(Q);
306: PetscFree(work);
307: return(0);
308: }
312: PetscErrorCode QEPSetFromOptions_QArnoldi(QEP qep)
313: {
315: QEP_QARNOLDI *ctx = (QEP_QARNOLDI*)qep->data;
316:
318: KSPSetFromOptions(ctx->ksp);
319: return(0);
320: }
324: PetscErrorCode QEPView_QArnoldi(QEP qep,PetscViewer viewer)
325: {
327: QEP_QARNOLDI *ctx = (QEP_QARNOLDI*)qep->data;
330: PetscViewerASCIIPushTab(viewer);
331: KSPView(ctx->ksp,viewer);
332: PetscViewerASCIIPopTab(viewer);
333: return(0);
334: }
338: PetscErrorCode QEPReset_QArnoldi(QEP qep)
339: {
341: QEP_QARNOLDI *ctx = (QEP_QARNOLDI*)qep->data;
344: PetscFree(qep->T);
345: KSPReset(ctx->ksp);
346: QEPDefaultFreeWork(qep);
347: QEPFreeSolution(qep);
348: return(0);
349: }
353: PetscErrorCode QEPDestroy_QArnoldi(QEP qep)
354: {
356: QEP_QARNOLDI *ctx = (QEP_QARNOLDI*)qep->data;
359: KSPDestroy(&ctx->ksp);
360: PetscFree(qep->data);
361: return(0);
362: }
364: EXTERN_C_BEGIN
367: PetscErrorCode QEPCreate_QArnoldi(QEP qep)
368: {
370: QEP_QARNOLDI *ctx;
373: PetscNewLog(qep,QEP_QARNOLDI,&ctx);
374: qep->data = ctx;
375: qep->ops->solve = QEPSolve_QArnoldi;
376: qep->ops->setup = QEPSetUp_QArnoldi;
377: qep->ops->setfromoptions = QEPSetFromOptions_QArnoldi;
378: qep->ops->destroy = QEPDestroy_QArnoldi;
379: qep->ops->reset = QEPReset_QArnoldi;
380: qep->ops->view = QEPView_QArnoldi;
381: KSPCreate(((PetscObject)qep)->comm,&ctx->ksp);
382: KSPSetOptionsPrefix(ctx->ksp,((PetscObject)qep)->prefix);
383: KSPAppendOptionsPrefix(ctx->ksp,"qep_");
384: PetscObjectIncrementTabLevel((PetscObject)ctx->ksp,(PetscObject)qep,1);
385: PetscLogObjectParent(qep,ctx->ksp);
386: return(0);
387: }
388: EXTERN_C_END