Actual source code: dvd_calcpairs.c
1: /*
2: SLEPc eigensolver: "davidson"
4: Step: calc the best eigenpairs in the subspace V.
6: For that, performs these steps:
7: 1) Update W <- A * V
8: 2) Update H <- V' * W
9: 3) Obtain eigenpairs of H
10: 4) Select some eigenpairs
11: 5) Compute the Ritz pairs of the selected ones
13: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
14: SLEPc - Scalable Library for Eigenvalue Problem Computations
15: Copyright (c) 2002-2013, Universitat Politecnica de Valencia, Spain
17: This file is part of SLEPc.
19: SLEPc is free software: you can redistribute it and/or modify it under the
20: terms of version 3 of the GNU Lesser General Public License as published by
21: the Free Software Foundation.
23: SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY
24: WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
25: FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for
26: more details.
28: You should have received a copy of the GNU Lesser General Public License
29: along with SLEPc. If not, see <http://www.gnu.org/licenses/>.
30: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
31: */
33: #include davidson.h
34: #include <slepcblaslapack.h>
36: PetscErrorCode dvd_calcpairs_proj(dvdDashboard *d);
37: PetscErrorCode dvd_calcpairs_qz_start(dvdDashboard *d);
38: PetscErrorCode dvd_calcpairs_qz_d(dvdDashboard *d);
39: PetscErrorCode dvd_calcpairs_projeig_solve(dvdDashboard *d);
40: PetscErrorCode dvd_calcpairs_selectPairs(dvdDashboard *d,PetscInt n);
41: PetscErrorCode dvd_calcpairs_X(dvdDashboard *d,PetscInt r_s,PetscInt r_e,Vec *X);
42: PetscErrorCode dvd_calcpairs_Y(dvdDashboard *d,PetscInt r_s,PetscInt r_e,Vec *Y);
43: PetscErrorCode dvd_calcpairs_res_0(dvdDashboard *d,PetscInt r_s,PetscInt r_e,Vec *R);
44: PetscErrorCode dvd_calcpairs_eig_res_0(dvdDashboard *d,PetscInt r_s,PetscInt r_e,Vec *R);
45: PetscErrorCode dvd_calcpairs_proj_res(dvdDashboard *d,PetscInt r_s,PetscInt r_e,Vec *R);
46: PetscErrorCode dvd_calcpairs_updateV0(dvdDashboard *d,DvdReduction *r,DvdMult_copy_func **sr);
47: PetscErrorCode dvd_calcpairs_updateV1(dvdDashboard *d);
48: PetscErrorCode dvd_calcpairs_updateW0(dvdDashboard *d,DvdReduction *r,DvdMult_copy_func **sr);
49: PetscErrorCode dvd_calcpairs_updateW1(dvdDashboard *d);
50: PetscErrorCode dvd_calcpairs_updateAV0(dvdDashboard *d);
51: PetscErrorCode dvd_calcpairs_updateAV1(dvdDashboard *d,DvdReduction *r,DvdMult_copy_func **sr);
52: PetscErrorCode dvd_calcpairs_updateBV0(dvdDashboard *d);
53: PetscErrorCode dvd_calcpairs_updateBV1(dvdDashboard *d,DvdReduction *r,DvdMult_copy_func **sr);
54: PETSC_STATIC_INLINE PetscErrorCode dvd_calcpairs_updateBV0_gen(dvdDashboard *d,Vec *real_BV,PetscInt *size_cX,Vec **BV,PetscInt *size_BV,PetscInt *max_size_BV,PetscBool BV_shift,PetscInt *cX_in_proj,DSMatType MT);
56: /**** Control routines ********************************************************/
59: PetscErrorCode dvd_calcpairs_qz(dvdDashboard *d,dvdBlackboard *b,EPSOrthType orth,IP ipI,PetscInt cX_proj,PetscBool harm)
60: {
62: PetscInt i,max_cS;
63: PetscBool std_probl,her_probl,ind_probl,her_ind_probl;
64: DSType dstype;
65: const char *prefix;
66: PetscErrorCode (*f)(PetscScalar,PetscScalar,PetscScalar,PetscScalar,PetscInt*,void*);
67: void *ctx;
70: std_probl = DVD_IS(d->sEP, DVD_EP_STD)?PETSC_TRUE:PETSC_FALSE;
71: her_probl = DVD_IS(d->sEP, DVD_EP_HERMITIAN)?PETSC_TRUE:PETSC_FALSE;
72: ind_probl = DVD_IS(d->sEP, DVD_EP_INDEFINITE)?PETSC_TRUE:PETSC_FALSE;
73: her_ind_probl = (her_probl || ind_probl)? PETSC_TRUE:PETSC_FALSE;
75: /* Setting configuration constrains */
76: #if !defined(PETSC_USE_COMPLEX)
77: /* if the last converged eigenvalue is complex its conjugate pair is also
78: converged */
79: b->max_nev = PetscMax(b->max_nev, d->nev+(her_probl && !d->B?0:1));
80: #else
81: b->max_nev = PetscMax(b->max_nev, d->nev);
82: #endif
83: b->max_size_proj = PetscMax(b->max_size_proj, b->max_size_V+cX_proj);
84: d->size_real_V = b->max_size_V+b->max_nev;
85: d->W_shift = d->B?PETSC_TRUE:PETSC_FALSE;
86: d->size_real_W = harm?(b->max_size_V+(d->W_shift?b->max_nev:b->max_size_cP)):0;
87: d->size_real_AV = b->max_size_V+b->max_size_cP;
88: d->size_BDS = 0;
89: if (d->B && her_ind_probl && (orth == EPS_ORTH_I || orth == EPS_ORTH_BOPT)) {
90: d->size_real_BV = b->size_V; d->BV_shift = PETSC_TRUE;
91: if (orth == EPS_ORTH_BOPT) d->size_BDS = d->eps->nds;
92: } else if (d->B) {
93: d->size_real_BV = b->max_size_V + b->max_size_P; d->BV_shift = PETSC_FALSE;
94: } else {
95: d->size_real_BV = 0; d->BV_shift = PETSC_FALSE;
96: }
97: b->own_vecs+= d->size_real_V + d->size_real_W + d->size_real_AV +
98: d->size_real_BV + d->size_BDS;
99: b->own_scalars+= b->max_size_proj*b->max_size_proj*2*(std_probl?1:2) +
100: /* H, G?, S, T? */
101: b->max_nev*b->max_nev*(her_ind_probl?0:(!d->B?1:2)) +
102: /* cS?, cT? */
103: FromRealToScalar(d->size_real_V)*(ind_probl?1:0) + /* nBV */
104: FromRealToScalar(b->max_size_proj)*(ind_probl?1:0) + /* nBpX */
105: (d->eps->arbitrary? b->size_V*2 : 0); /* rr, ri */
106: b->max_size_auxV = PetscMax(b->max_size_auxV, b->max_size_X);
107: /* updateV0 */
108: max_cS = PetscMax(b->max_size_X,cX_proj);
109: b->max_size_auxS = PetscMax(PetscMax(
110: b->max_size_auxS,
111: b->max_size_proj*b->max_size_proj*2*(std_probl?1:2) + /* updateAV1,BV1 */
112: max_cS*b->max_nev*(her_ind_probl?0:(!d->B?1:2)) + /* updateV0,W0 */
113: /* SlepcReduction: in */
114: PetscMax(
115: b->max_size_proj*b->max_size_proj*2*(std_probl?1:2) + /* updateAV1,BV1 */
116: max_cS*b->max_nev*(her_ind_probl?0:(!d->B?1:2)), /* updateV0,W0 */
117: /* SlepcReduction: out */
118: PetscMax(
119: b->max_size_proj*b->max_size_proj, /* updateAV0,BV0 */
120: b->max_size_proj+b->max_nev))), /* dvd_orth */
121: std_probl?0:(b->max_size_proj*11+16) /* projeig */);
122: #if defined(PETSC_USE_COMPLEX)
123: b->max_size_auxS = PetscMax(b->max_size_auxS, b->max_size_V);
124: /* dvd_calcpairs_projeig_eig */
125: #endif
127: /* Setup the step */
128: if (b->state >= DVD_STATE_CONF) {
129: d->max_cX_in_proj = cX_proj;
130: d->max_size_P = b->max_size_P;
131: d->real_V = b->free_vecs; b->free_vecs+= d->size_real_V;
132: if (harm) {
133: d->real_W = b->free_vecs; b->free_vecs+= d->size_real_W;
134: } else {
135: d->real_W = NULL;
136: }
137: d->real_AV = d->AV = b->free_vecs; b->free_vecs+= d->size_real_AV;
138: d->max_size_proj = b->max_size_proj;
139: d->real_H = b->free_scalars; b->free_scalars+= b->max_size_proj*b->max_size_proj;
140: d->ldH = b->max_size_proj;
141: d->S = b->free_scalars; b->free_scalars+= b->max_size_proj*b->max_size_proj;
142: if (!her_ind_probl) {
143: d->cS = b->free_scalars; b->free_scalars+= b->max_nev*b->max_nev;
144: d->max_size_cS = d->ldcS = b->max_nev;
145: } else {
146: d->cS = NULL;
147: d->max_size_cS = d->ldcS = 0;
148: d->orthoV_type = orth;
149: if (ind_probl) {
150: d->real_nBV = (PetscReal*)b->free_scalars; b->free_scalars+= FromRealToScalar(d->size_real_V);
151: d->nBpX = (PetscReal*)b->free_scalars; b->free_scalars+= FromRealToScalar(d->max_size_proj);
152: } else d->real_nBV = d->nBDS = d->nBpX = NULL;
153: }
154: d->ipV = ipI;
155: d->ipW = ipI;
156: if (orth == EPS_ORTH_BOPT) {
157: d->BDS = b->free_vecs; b->free_vecs+= d->eps->nds;
158: for (i=0; i<d->eps->nds; i++) {
159: MatMult(d->B, d->eps->defl[i], d->BDS[i]);
160: }
161: } else d->BDS = NULL;
162: if (d->B) {
163: d->real_BV = b->free_vecs; b->free_vecs+= d->size_real_BV;
164: } else {
165: d->size_real_BV = 0;
166: d->real_BV = NULL;
167: d->BV_shift = PETSC_FALSE;
168: }
169: if (!std_probl) {
170: d->real_G = b->free_scalars; b->free_scalars+= b->max_size_proj*b->max_size_proj;
171: d->T = b->free_scalars; b->free_scalars+= b->max_size_proj*b->max_size_proj;
172: } else {
173: d->real_G = NULL;
174: d->T = NULL;
175: }
176: if (d->B && !her_ind_probl) {
177: d->cT = b->free_scalars; b->free_scalars+= b->max_nev*b->max_nev;
178: d->ldcT = b->max_nev;
179: } else {
180: d->cT = NULL;
181: d->ldcT = 0;
182: }
183: if (d->eps->arbitrary) {
184: d->eps->rr = b->free_scalars; b->free_scalars+= b->size_V;
185: d->eps->ri = b->free_scalars; b->free_scalars+= b->size_V;
186: } else {
187: d->eps->rr = NULL;
188: d->eps->ri = NULL;
189: }
190: /* Create a DS if the method works with Schur decompositions */
191: if (d->cS) {
192: DSCreate(PetscObjectComm((PetscObject)d->eps->ds),&d->conv_ps);
193: DSSetType(d->conv_ps,d->cT ? DSGNHEP : DSNHEP);
194: /* Transfer as much as possible options from eps->ds to conv_ps */
195: DSGetOptionsPrefix(d->eps->ds,&prefix);
196: DSSetOptionsPrefix(d->conv_ps,prefix);
197: DSSetFromOptions(d->conv_ps);
198: DSGetEigenvalueComparison(d->eps->ds,&f,&ctx);
199: DSSetEigenvalueComparison(d->conv_ps,f,ctx);
200: DSAllocate(d->conv_ps,b->max_nev);
201: PetscLogObjectParent(d->eps,d->conv_ps);
202: } else {
203: d->conv_ps = NULL;
204: }
205: d->calcPairs = dvd_calcpairs_proj;
206: d->calcpairs_residual = dvd_calcpairs_res_0;
207: d->calcpairs_residual_eig = dvd_calcpairs_eig_res_0;
208: d->calcpairs_proj_res = dvd_calcpairs_proj_res;
209: d->calcpairs_selectPairs = dvd_calcpairs_selectPairs;
210: d->ipI = ipI;
211: /* Create and configure a DS for solving the projected problems */
212: if (d->real_W) { /* If we use harmonics */
213: dstype = DSGNHEP;
214: } else {
215: if (ind_probl) {
216: dstype = DSGHIEP;
217: } else if (std_probl) {
218: dstype = her_probl ? DSHEP : DSNHEP;
219: } else {
220: dstype = her_probl ? DSGHEP : DSGNHEP;
221: }
222: }
223: d->ps = d->eps->ds;
224: DSSetType(d->ps,dstype);
225: DSAllocate(d->ps,d->max_size_proj);
227: DVD_FL_ADD(d->startList, dvd_calcpairs_qz_start);
228: DVD_FL_ADD(d->destroyList, dvd_calcpairs_qz_d);
229: }
230: return(0);
231: }
235: PetscErrorCode dvd_calcpairs_qz_start(dvdDashboard *d)
236: {
237: PetscBool her_probl,ind_probl,her_ind_probl;
238: PetscInt i;
241: her_probl = DVD_IS(d->sEP, DVD_EP_HERMITIAN)?PETSC_TRUE:PETSC_FALSE;
242: ind_probl = DVD_IS(d->sEP, DVD_EP_INDEFINITE)?PETSC_TRUE:PETSC_FALSE;
243: her_ind_probl = (her_probl || ind_probl)? PETSC_TRUE:PETSC_FALSE;
245: d->size_V = 0;
246: d->V = d->real_V;
247: d->cX = d->real_V;
248: d->size_cX = 0;
249: d->max_size_V = d->size_real_V;
250: d->W = d->real_W;
251: d->max_size_W = d->size_real_W;
252: d->size_W = 0;
253: d->size_AV = 0;
254: d->AV = d->real_AV;
255: d->max_size_AV = d->size_real_AV;
256: d->size_H = 0;
257: d->H = d->real_H;
258: if (d->cS) for (i=0; i<d->max_size_cS*d->max_size_cS; i++) d->cS[i] = 0.0;
259: d->size_BV = 0;
260: d->BV = d->real_BV;
261: d->max_size_BV = d->size_real_BV;
262: d->size_G = 0;
263: d->G = d->real_G;
264: if (d->cT) for (i=0; i<d->max_size_cS*d->max_size_cS; i++) d->cT[i] = 0.0;
265: d->cY = d->B && !her_ind_probl ? d->W : NULL;
266: d->BcX = d->orthoV_type == EPS_ORTH_I && d->B && her_probl ? d->BcX : NULL;
267: d->size_cY = 0;
268: d->size_BcX = 0;
269: d->cX_in_V = d->cX_in_H = d->cX_in_G = d->cX_in_W = d->cX_in_AV = d->cX_in_BV = 0;
270: d->nBV = d->nBcX = d->real_nBV;
271: return(0);
272: }
276: PetscErrorCode dvd_calcpairs_qz_d(dvdDashboard *d)
277: {
278: PetscErrorCode ierr;
281: DSDestroy(&d->conv_ps);
282: return(0);
283: }
287: PetscErrorCode dvd_calcpairs_proj(dvdDashboard *d)
288: {
289: PetscErrorCode ierr;
290: DvdReduction r;
291: #define MAX_OPS 7
292: DvdReductionChunk
293: ops[MAX_OPS];
294: DvdMult_copy_func
295: sr[MAX_OPS], *sr0 = sr;
296: PetscInt size_in, i;
297: PetscScalar *in = d->auxS, *out;
298: PetscBool stdp;
301: stdp = DVD_IS(d->sEP, DVD_EP_STD)?PETSC_TRUE:PETSC_FALSE;
302: size_in =
303: (d->size_cX+d->V_tra_s-d->cX_in_H)*d->V_tra_s*(d->cT?2:(d->cS?1:0)) + /* updateV0,W0 */
304: (d->size_H*(d->V_new_e-d->V_new_s)*2+
305: (d->V_new_e-d->V_new_s)*(d->V_new_e-d->V_new_s))*(!stdp?2:1); /* updateAV1,BV1 */
307: out = in+size_in;
309: /* Check consistency */
310: if (2*size_in > d->size_auxS) SETERRQ(PETSC_COMM_SELF,1, "Consistency broken");
312: /* Prepare reductions */
313: SlepcAllReduceSumBegin(ops, MAX_OPS, in, out, size_in, &r,
314: PetscObjectComm((PetscObject)d->V[0]));
315: /* Allocate size_in */
316: d->auxS+= size_in;
317: d->size_auxS-= size_in;
319: /* Update AV, BV, W and the projected matrices */
320: /* 1. S <- S*MT */
321: dvd_calcpairs_updateV0(d, &r, &sr0);
322: dvd_calcpairs_updateW0(d, &r, &sr0);
323: dvd_calcpairs_updateAV0(d);
324: dvd_calcpairs_updateBV0(d);
325: /* 2. V <- orth(V, V_new) */
326: dvd_calcpairs_updateV1(d);
327: /* 3. AV <- [AV A * V(V_new_s:V_new_e-1)] */
328: /* Check consistency */
329: if (d->size_AV != d->V_new_s) SETERRQ(PETSC_COMM_SELF,1, "Consistency broken");
330: for (i=d->V_new_s; i<d->V_new_e; i++) {
331: MatMult(d->A, d->V[i], d->AV[i]);
332: }
333: d->size_AV = d->V_new_e;
334: /* 4. BV <- [BV B * V(V_new_s:V_new_e-1)] */
335: if (d->B && d->orthoV_type != EPS_ORTH_BOPT) {
336: /* Check consistency */
337: if (d->size_BV != d->V_new_s) SETERRQ(PETSC_COMM_SELF,1, "Consistency broken");
338: for (i=d->V_new_s; i<d->V_new_e; i++) {
339: MatMult(d->B, d->V[i], d->BV[i]);
340: }
341: d->size_BV = d->V_new_e;
342: }
343: /* 5 <- W <- [W f(AV,BV)] */
344: dvd_calcpairs_updateW1(d);
345: dvd_calcpairs_updateAV1(d, &r, &sr0);
346: dvd_calcpairs_updateBV1(d, &r, &sr0);
348: /* Deallocate size_in */
349: d->auxS-= size_in;
350: d->size_auxS+= size_in;
352: /* Do reductions */
353: SlepcAllReduceSumEnd(&r);
355: /* Perform the transformation on the projected problem */
356: if (d->calcpairs_proj_trans) {
357: d->calcpairs_proj_trans(d);
358: }
360: d->V_tra_s = d->V_tra_e = 0;
361: d->V_new_s = d->V_new_e;
363: /* Solve the projected problem */
364: if (d->size_H>0) {
365: dvd_calcpairs_projeig_solve(d);
366: }
368: /* Check consistency */
369: if (d->size_V != d->V_new_e || d->size_V+d->cX_in_H != d->size_H || d->cX_in_V != d->cX_in_H ||
370: d->size_V != d->size_AV || d->cX_in_H != d->cX_in_AV ||
371: (DVD_ISNOT(d->sEP, DVD_EP_STD) && (
372: d->size_V+d->cX_in_G != d->size_G || d->cX_in_H != d->cX_in_G ||
373: d->size_H != d->size_G || (d->BV && (
374: d->size_V != d->size_BV || d->cX_in_H != d->cX_in_BV)))) ||
375: (d->W && d->size_W != d->size_V)) {
376: SETERRQ(PETSC_COMM_SELF,1, "Consistency broken");
377: }
378: return(0);
379: #undef MAX_OPS
380: }
382: /**** Basic routines **********************************************************/
386: /* auxV: V_tra_s, DvdMult_copy_func: 1 */
387: PetscErrorCode dvd_calcpairs_updateV0(dvdDashboard *d,DvdReduction *r,DvdMult_copy_func **sr)
388: {
389: PetscErrorCode ierr;
390: PetscInt rm,i,ld;
391: PetscScalar *pQ;
394: if (d->V_tra_s == 0 && d->V_tra_e == 0) return(0);
396: /* Update nBcX and nBV */
397: if (d->nBcX && d->nBpX && d->nBV) {
398: d->nBV+= d->V_tra_s;
399: for (i=0; i<d->V_tra_s; i++) d->nBcX[d->size_cX+i] = d->nBpX[i];
400: for (i=d->V_tra_s; i<d->V_tra_e; i++) d->nBV[i-d->V_tra_s] = d->nBpX[i];
401: }
403: /* cX <- [cX V*MT(0:V_tra_s-1)], V <- V*MT(V_tra_s:V_tra_e) */
404: dvd_calcpairs_updateBV0_gen(d,d->real_V,&d->size_cX,&d->V,&d->size_V,&d->max_size_V,PETSC_TRUE,&d->cX_in_V,DS_MAT_Q);
406: /* Udpate cS for standard problems */
407: if (d->cS && !d->cT && !d->cY && (d->V_tra_s > d->max_cX_in_proj || d->size_cX >= d->nev)) {
408: /* Check consistency */
409: if (d->size_cS+d->V_tra_s != d->size_cX) SETERRQ(PETSC_COMM_SELF,1, "Consistency broken");
411: /* auxV <- AV * ps.Q(0:V_tra_e-1) */
412: rm = d->size_cX>=d->nev?0:d->max_cX_in_proj;
413: DSGetLeadingDimension(d->ps,&ld);
414: DSGetArray(d->ps,DS_MAT_Q,&pQ);
415: SlepcUpdateVectorsZ(d->auxV,0.0,1.0,d->AV-d->cX_in_AV,d->size_AV+d->cX_in_AV,pQ,ld,d->size_MT,d->V_tra_s-rm);
416: DSRestoreArray(d->ps,DS_MAT_Q,&pQ);
418: /* cS(:, size_cS:) <- cX' * auxV */
419: VecsMultS(&d->cS[d->ldcS*d->size_cS], 0, d->ldcS, d->cX, 0, d->size_cX-rm, d->auxV, 0, d->V_tra_s-rm, r, (*sr)++);
420: d->size_cS+= d->V_tra_s-rm;
421: }
422: return(0);
423: }
427: /* auxS: size_cX+V_new_e+1 */
428: PetscErrorCode dvd_calcpairs_updateV1(dvdDashboard *d)
429: {
430: PetscErrorCode ierr;
431: Vec *cX = d->BcX? d->BcX : ((d->cY && !d->W)? d->cY : d->cX);
434: if (d->V_new_s == d->V_new_e) return(0);
436: /* Check consistency */
437: if (d->size_V != d->V_new_s) SETERRQ(PETSC_COMM_SELF,1, "Consistency broken");
439: /* V <- gs([cX V(0:V_new_s-1)], V(V_new_s:V_new_e-1)) */
440: if (d->orthoV_type == EPS_ORTH_BOPT) {
441: dvd_BorthV_faster(d->ipV,d->eps->defl,d->BDS,d->nBDS,d->eps->nds,d->cX,d->real_BV,d->nBcX,d->size_cX,d->V,d->BV,d->nBV,d->V_new_s,d->V_new_e,d->auxS,d->eps->rand);
442: d->size_BV = d->V_new_e;
443: } else if (DVD_IS(d->sEP, DVD_EP_INDEFINITE)) {
444: dvd_BorthV_stable(d->ipV,d->eps->defl,d->nBDS,d->eps->nds,d->cX,d->nBcX,d->size_cX,d->V,d->nBV,d->V_new_s,d->V_new_e,d->auxS,d->eps->rand);
445: } else {
446: dvd_orthV(d->ipV,d->eps->defl,d->eps->nds,cX,d->size_cX,d->V,d->V_new_s,d->V_new_e,d->auxS,d->eps->rand);
447: }
448: d->size_V = d->V_new_e;
449: return(0);
450: }
454: /* auxV: V_tra_s, DvdMult_copy_func: 2 */
455: PetscErrorCode dvd_calcpairs_updateW0(dvdDashboard *d,DvdReduction *r,DvdMult_copy_func **sr)
456: {
457: PetscErrorCode ierr;
458: PetscInt rm,ld;
459: PetscScalar *pQ;
462: if (d->V_tra_s == 0 && d->V_tra_e == 0) return(0);
464: /* cY <- [cY W*ps.Z(0:V_tra_s-1)], W <- W*ps.Z(V_tra_s:V_tra_e) */
465: dvd_calcpairs_updateBV0_gen(d,d->real_W,&d->size_cY,&d->W,&d->size_W,&d->max_size_W,d->W_shift,&d->cX_in_W,DS_MAT_Z);
467: /* Udpate cS and cT */
468: if (d->cT && (d->V_tra_s > d->max_cX_in_proj || d->size_cX >= d->nev)) {
469: /* Check consistency */
470: if (d->size_cS+d->V_tra_s != d->size_cX || (d->W && d->size_cY != d->size_cX)) SETERRQ(PETSC_COMM_SELF,1, "Consistency broken");
472: DSGetLeadingDimension(d->ps,&ld);
473: DSGetArray(d->ps,DS_MAT_Q,&pQ);
474: /* auxV <- AV * ps.Q(0:V_tra_e-1) */
475: rm = d->size_cX>=d->nev?0:d->max_cX_in_proj;
476: SlepcUpdateVectorsZ(d->auxV,0.0,1.0,d->AV-d->cX_in_H,d->size_AV-d->cX_in_H,pQ,ld,d->size_MT,d->V_tra_s-rm);
478: /* cS(:, size_cS:) <- cY' * auxV */
479: VecsMultS(&d->cS[d->ldcS*d->size_cS], 0, d->ldcS, d->cY?d->cY:d->cX, 0, d->size_cX-rm, d->auxV, 0, d->V_tra_s-rm, r, (*sr)++);
481: /* auxV <- BV * ps.Q(0:V_tra_e-1) */
482: SlepcUpdateVectorsZ(d->auxV,0.0,1.0,d->BV-d->cX_in_H,d->size_BV-d->cX_in_H,pQ,ld,d->size_MT,d->V_tra_s-rm);
483: DSRestoreArray(d->ps,DS_MAT_Q,&pQ);
485: /* cT(:, size_cS:) <- cY' * auxV */
486: VecsMultS(&d->cT[d->ldcS*d->size_cS], 0, d->ldcS, d->cY?d->cY:d->cX, 0, d->size_cX-rm, d->auxV, 0, d->V_tra_s-rm, r, (*sr)++);
488: d->size_cS+= d->V_tra_s-rm;
489: d->size_cT+= d->V_tra_s-rm;
490: }
491: return(0);
492: }
496: /* auxS: size_cX+V_new_e+1 */
497: PetscErrorCode dvd_calcpairs_updateW1(dvdDashboard *d)
498: {
499: PetscErrorCode ierr;
500: Vec *cY = d->cY?d->cY:d->cX;
503: if (!d->W || d->V_new_s == d->V_new_e) return(0);
505: /* Check consistency */
506: if (d->size_W != d->V_new_s) SETERRQ(PETSC_COMM_SELF,1, "Consistency broken");
508: /* Update W */
509: d->calcpairs_W(d);
511: /* W <- gs([cY W(0:V_new_s-1)], W(V_new_s:V_new_e-1)) */
512: dvd_orthV(d->ipW, NULL, 0, cY, d->size_cX, d->W-d->cX_in_W, d->V_new_s+d->cX_in_W, d->V_new_e+d->cX_in_W, d->auxS, d->eps->rand);
513: d->size_W = d->V_new_e;
514: return(0);
515: }
519: /* auxS: size_H*(V_tra_e-V_tra_s) */
520: PetscErrorCode dvd_calcpairs_updateAV0(dvdDashboard *d)
521: {
522: PetscErrorCode ierr;
523: PetscInt cMT,tra_s,ld;
524: PetscScalar *pQ,*pZ;
527: if (d->V_tra_s == 0 && d->V_tra_e == 0) return(0);
529: /* AV(V_tra_s-cp-1:) = cAV*ps.Q(V_tra_s:) */
530: dvd_calcpairs_updateBV0_gen(d,d->real_AV,NULL,&d->AV,&d->size_AV,&d->max_size_AV,PETSC_FALSE,&d->cX_in_AV,DS_MAT_Q);
531: tra_s = PetscMax(d->V_tra_s-d->max_cX_in_proj,0);
532: cMT = d->V_tra_e - tra_s;
534: /* Update H <- ps.Z(tra_s)' * (H * ps.Q(tra_s:)) */
535: DSGetLeadingDimension(d->ps,&ld);
536: DSGetArray(d->ps,DS_MAT_Q,&pQ);
537: if (d->W) {
538: DSGetArray(d->ps,DS_MAT_Z,&pZ);
539: } else pZ = pQ;
540: SlepcDenseMatProdTriang(d->auxS,0,d->ldH,d->H,d->sH,d->ldH,d->size_H,d->size_H,PETSC_FALSE,&pQ[ld*tra_s],0,ld,d->size_MT,cMT,PETSC_FALSE);
541: SlepcDenseMatProdTriang(d->H,d->sH,d->ldH,&pZ[ld*tra_s],0,ld,d->size_MT,cMT,PETSC_TRUE,d->auxS,0,d->ldH,d->size_H,cMT,PETSC_FALSE);
542: DSRestoreArray(d->ps,DS_MAT_Q,&pQ);
543: if (d->W) {
544: DSRestoreArray(d->ps,DS_MAT_Z,&pZ);
545: }
546: d->size_H = cMT;
547: d->cX_in_H = d->cX_in_AV;
548: return(0);
549: }
553: /* DvdMult_copy_func: 2 */
554: PetscErrorCode dvd_calcpairs_updateAV1(dvdDashboard *d,DvdReduction *r,DvdMult_copy_func **sr)
555: {
556: PetscErrorCode ierr;
557: Vec *W = d->W?d->W:d->V;
560: if (d->V_new_s == d->V_new_e) return(0);
562: /* Check consistency */
563: if (d->size_H != d->V_new_s+d->cX_in_H || d->size_V != d->V_new_e) SETERRQ(PETSC_COMM_SELF,1, "Consistency broken");
565: /* H = [H W(old)'*AV(new);
566: W(new)'*AV(old) W(new)'*AV(new) ],
567: being old=0:V_new_s-1, new=V_new_s:V_new_e-1 */
568: VecsMultS(d->H,d->sH,d->ldH,W-d->cX_in_H,d->V_new_s+d->cX_in_H, d->V_new_e+d->cX_in_H, d->AV-d->cX_in_H,d->V_new_s+d->cX_in_H,d->V_new_e+d->cX_in_H, r, (*sr)++);
569: d->size_H = d->V_new_e+d->cX_in_H;
570: return(0);
571: }
575: /* auxS: max(BcX*(size_cX+V_new_e+1), size_G*(V_tra_e-V_tra_s)) */
576: PetscErrorCode dvd_calcpairs_updateBV0(dvdDashboard *d)
577: {
578: PetscErrorCode ierr;
579: PetscInt cMT,tra_s,i,ld;
580: PetscBool lindep;
581: PetscReal norm;
582: PetscScalar *pQ,*pZ;
585: if (d->V_tra_s == 0 && d->V_tra_e == 0) return(0);
587: /* BV <- BV*MT */
588: dvd_calcpairs_updateBV0_gen(d,d->real_BV,NULL,&d->BV,&d->size_BV,&d->max_size_BV,d->BV_shift,&d->cX_in_BV,DS_MAT_Q);
590: /* If BcX, BcX <- orth(BcX) */
591: if (d->BcX) {
592: for (i=0; i<d->V_tra_s; i++) {
593: IPOrthogonalize(d->ipI, 0, NULL, d->size_BcX+i, NULL,
594: d->BcX, d->BcX[d->size_BcX+i], NULL,
595: &norm, &lindep);
596: if (lindep) SETERRQ(PETSC_COMM_SELF,1, "Error during orth(BcX, B*cX(new))");
597: VecScale(d->BcX[d->size_BcX+i], 1.0/norm);
598: }
599: d->size_BcX+= d->V_tra_s;
600: }
602: /* Update G <- ps.Z' * (G * ps.Q) */
603: if (d->G) {
604: tra_s = PetscMax(d->V_tra_s-d->max_cX_in_proj,0);
605: cMT = d->V_tra_e - tra_s;
606: DSGetLeadingDimension(d->ps,&ld);
607: DSGetArray(d->ps,DS_MAT_Q,&pQ);
608: if (d->W) {
609: DSGetArray(d->ps,DS_MAT_Z,&pZ);
610: } else pZ = pQ;
611: SlepcDenseMatProdTriang(d->auxS,0,d->ldH,d->G,d->sG,d->ldH,d->size_G,d->size_G,PETSC_FALSE,&pQ[ld*tra_s],0,ld,d->size_MT,cMT,PETSC_FALSE);
612: SlepcDenseMatProdTriang(d->G,d->sG,d->ldH,&pZ[ld*tra_s],0,ld,d->size_MT,cMT,PETSC_TRUE,d->auxS,0,d->ldH,d->size_G,cMT,PETSC_FALSE);
613: DSRestoreArray(d->ps,DS_MAT_Q,&pQ);
614: if (d->W) {
615: DSRestoreArray(d->ps,DS_MAT_Z,&pZ);
616: }
617: d->size_G = cMT;
618: d->cX_in_G = d->cX_in_V;
619: }
620: return(0);
621: }
625: /* DvdMult_copy_func: 2 */
626: PetscErrorCode dvd_calcpairs_updateBV1(dvdDashboard *d,DvdReduction *r,DvdMult_copy_func **sr)
627: {
628: PetscErrorCode ierr;
629: Vec *W = d->W?d->W:d->V, *BV = d->BV?d->BV:d->V;
632: if (!d->G || d->V_new_s == d->V_new_e) return(0);
634: /* G = [G W(old)'*BV(new);
635: W(new)'*BV(old) W(new)'*BV(new) ],
636: being old=0:V_new_s-1, new=V_new_s:V_new_e-1 */
637: VecsMultS(d->G,d->sG,d->ldH,W-d->cX_in_G,d->V_new_s+d->cX_in_G,d->V_new_e+d->cX_in_G,BV-d->cX_in_G,d->V_new_s+d->cX_in_G,d->V_new_e+d->cX_in_G,r,(*sr)++);
638: d->size_G = d->V_new_e+d->cX_in_G;
639: return(0);
640: }
642: /* in complex, d->size_H real auxiliar values are needed */
645: PetscErrorCode dvd_calcpairs_projeig_solve(dvdDashboard *d)
646: {
647: PetscErrorCode ierr;
648: PetscScalar *A;
649: PetscInt ld,i;
652: DSSetDimensions(d->ps,d->size_H,0,0,0);
653: DSGetLeadingDimension(d->ps,&ld);
654: DSGetArray(d->ps,DS_MAT_A,&A);
655: SlepcDenseCopyTriang(A,0,ld,d->H,d->sH,d->ldH,d->size_H,d->size_H);
656: DSRestoreArray(d->ps,DS_MAT_A,&A);
657: if (d->G) {
658: DSGetArray(d->ps,DS_MAT_B,&A);
659: SlepcDenseCopyTriang(A,0,ld,d->G,d->sG,d->ldH,d->size_H,d->size_H);
660: DSRestoreArray(d->ps,DS_MAT_B,&A);
661: }
662: /* Set the signature on projected matrix B */
663: if (DVD_IS(d->sEP, DVD_EP_INDEFINITE)) {
664: DSGetArray(d->ps,DS_MAT_B,&A);
665: PetscMemzero(A,sizeof(PetscScalar)*d->size_H*ld);
666: for (i=0; i<d->size_H; i++) {
667: A[i+ld*i] = d->nBV[i];
668: }
669: DSRestoreArray(d->ps,DS_MAT_B,&A);
670: }
671: DSSetState(d->ps,DS_STATE_RAW);
672: DSSolve(d->ps,d->eigr-d->cX_in_H,d->eigi-d->cX_in_H);
673: return(0);
674: }
678: PetscErrorCode dvd_calcpairs_apply_arbitrary(dvdDashboard *d,PetscInt r_s,PetscInt r_e,PetscScalar **rr_,PetscScalar **ri_)
679: {
680: PetscInt i,k,ld;
681: PetscScalar *pX,*rr,*ri,ar,ai;
682: Vec *X = d->auxV,xr,xi;
683: PetscErrorCode ierr;
684: #if !defined(PETSC_USE_COMPLEX)
685: PetscInt j;
686: #endif
689: /* Quick exit without neither arbitrary selection nor harmonic extraction */
690: if (!d->eps->arbitrary && !d->calcpairs_eig_backtrans) {
691: *rr_ = d->eigr-d->cX_in_H;
692: *ri_ = d->eigi-d->cX_in_H;
693: return(0);
694: }
696: /* Quick exit without arbitrary selection, but with harmonic extraction */
697: if (!d->eps->arbitrary && d->calcpairs_eig_backtrans) {
698: *rr_ = rr = d->auxS;
699: *ri_ = ri = d->auxS+r_e-r_s;
700: for (i=r_s; i<r_e; i++) {
701: d->calcpairs_eig_backtrans(d,d->eigr[i],d->eigi[i],&rr[i-r_s],&ri[i-r_s]);
702: }
703: return(0);
704: }
706: DSGetLeadingDimension(d->ps,&ld);
707: *rr_ = rr = d->eps->rr + d->eps->nconv;
708: *ri_ = ri = d->eps->ri + d->eps->nconv;
709: for (i=r_s; i<r_e; i++) {
710: k = i;
711: DSVectors(d->ps,DS_MAT_X,&k,NULL);
712: DSNormalize(d->ps,DS_MAT_X,i);
713: DSGetArray(d->ps,DS_MAT_X,&pX);
714: dvd_improvex_compute_X(d,i,k+1,X,pX,ld);
715: DSRestoreArray(d->ps,DS_MAT_X,&pX);
716: #if !defined(PETSC_USE_COMPLEX)
717: if (d->nX[i] != 1.0) {
718: for (j=i; j<k+1; j++) {
719: VecScale(X[j-i],1/d->nX[i]);
720: }
721: }
722: xr = X[0];
723: xi = X[1];
724: if (i == k) {
725: VecZeroEntries(xi);
726: }
727: #else
728: xr = X[0];
729: xi = NULL;
730: if (d->nX[i] != 1.0) {
731: VecScale(xr,1.0/d->nX[i]);
732: }
733: #endif
734: if (d->calcpairs_eig_backtrans) {
735: d->calcpairs_eig_backtrans(d,d->eigr[i],d->eigi[i],&ar,&ai);
736: } else {
737: ar = d->eigr[i];
738: ai = d->eigi[i];
739: }
740: (d->eps->arbitrary)(ar,ai,xr,xi,&rr[i-r_s],&ri[i-r_s],d->eps->arbitraryctx);
741: #if !defined(PETSC_USE_COMPLEX)
742: if (i != k) {
743: rr[i+1-r_s] = rr[i-r_s];
744: ri[i+1-r_s] = ri[i-r_s];
745: i++;
746: }
747: #endif
748: }
749: return(0);
750: }
754: PetscErrorCode dvd_calcpairs_selectPairs(dvdDashboard *d,PetscInt n)
755: {
756: PetscInt k;
757: PetscScalar *rr,*ri;
758: PetscErrorCode ierr;
761: n = PetscMin(n,d->size_H-d->cX_in_H);
762: /* Put the best n pairs at the beginning. Useful for restarting */
763: DSSetDimensions(d->ps,0,0,d->cX_in_H,0);
764: dvd_calcpairs_apply_arbitrary(d,d->cX_in_H,d->size_H,&rr,&ri);
765: k = n;
766: DSSort(d->ps,d->eigr-d->cX_in_H,d->eigi-d->cX_in_H,rr,ri,&k);
767: /* Put the best pair at the beginning. Useful to check its residual */
768: #if !defined(PETSC_USE_COMPLEX)
769: if (n != 1 && (n != 2 || d->eigi[0] == 0.0))
770: #else
771: if (n != 1)
772: #endif
773: {
774: dvd_calcpairs_apply_arbitrary(d,d->cX_in_H,d->size_H,&rr,&ri);
775: k = 1;
776: DSSort(d->ps,d->eigr-d->cX_in_H,d->eigi-d->cX_in_H,rr,ri,&k);
777: }
778: if (d->calcpairs_eigs_trans) {
779: d->calcpairs_eigs_trans(d);
780: }
781: return(0);
782: }
786: /* Compute the residual vectors R(i) <- (AV - BV*eigr(i))*pX(i), and also
787: the norm associated to the Schur pair, where i = r_s..r_e
788: */
789: PetscErrorCode dvd_calcpairs_res_0(dvdDashboard *d,PetscInt r_s,PetscInt r_e,Vec *R)
790: {
791: PetscInt i,ldpX;
792: PetscScalar *pX;
793: PetscErrorCode ierr;
794: Vec *BV = d->BV?d->BV:d->V;
797: DSGetLeadingDimension(d->ps,&ldpX);
798: DSGetArray(d->ps,DS_MAT_Q,&pX);
799: for (i=r_s; i<r_e; i++) {
800: /* nX(i) <- ||X(i)|| */
801: if (d->correctXnorm) {
802: /* R(i) <- V*pX(i) */
803: SlepcUpdateVectorsZ(&R[i-r_s],0.0,1.0,&d->V[-d->cX_in_H],d->size_V+d->cX_in_H,&pX[ldpX*(i+d->cX_in_H)],ldpX,d->size_H,1);
804: VecNorm(R[i-r_s],NORM_2,&d->nX[i]);
805: } else d->nX[i] = 1.0;
806: /* R(i-r_s) <- AV*pX(i) */
807: SlepcUpdateVectorsZ(&R[i-r_s],0.0,1.0,&d->AV[-d->cX_in_H],d->size_AV+d->cX_in_H,&pX[ldpX*(i+d->cX_in_H)],ldpX,d->size_H,1);
808: /* R(i-r_s) <- R(i-r_s) - eigr(i)*BV*pX(i) */
809: SlepcUpdateVectorsZ(&R[i-r_s],1.0,-d->eigr[i+d->cX_in_H],&BV[-d->cX_in_H],d->size_V+d->cX_in_H,&pX[ldpX*(i+d->cX_in_H)],ldpX,d->size_H,1);
810: }
811: DSRestoreArray(d->ps,DS_MAT_Q,&pX);
812: d->calcpairs_proj_res(d, r_s, r_e, R);
813: return(0);
814: }
818: PetscErrorCode dvd_calcpairs_proj_res(dvdDashboard *d,PetscInt r_s,PetscInt r_e,Vec *R)
819: {
820: PetscInt i;
821: PetscErrorCode ierr;
822: PetscBool lindep;
823: Vec *cX;
826: /* If exists the BcX, R <- orth(BcX, R), nR[i] <- ||R[i]|| */
827: if (d->BcX)
828: cX = d->BcX;
830: /* If exists left subspace, R <- orth(cY, R), nR[i] <- ||R[i]|| */
831: else if (d->cY) cX = d->cY;
833: /* If fany configurations, R <- orth(cX, R), nR[i] <- ||R[i]|| */
834: else if (!(DVD_IS(d->sEP, DVD_EP_STD) && DVD_IS(d->sEP, DVD_EP_HERMITIAN))) cX = d->cX;
836: /* Otherwise, nR[i] <- ||R[i]|| */
837: else cX = NULL;
839: if (cX) {
840: if (cX && d->orthoV_type == EPS_ORTH_BOPT) {
841: Vec auxV;
842: VecDuplicate(d->auxV[0],&auxV);
843: for (i=0; i<r_e-r_s; i++) {
844: IPBOrthogonalize(d->ipV,d->eps->nds,d->eps->defl,d->BDS,d->nBDS,d->size_cX,NULL,d->cX,d->real_BV,d->nBcX,R[i],auxV,NULL,&d->nR[r_s+i],&lindep);
845: }
846: VecDestroy(&auxV);
847: } else if (DVD_IS(d->sEP, DVD_EP_INDEFINITE)) {
848: for (i=0; i<r_e-r_s; i++) {
849: IPPseudoOrthogonalize(d->ipV,d->size_cX,cX,d->nBcX,R[i],NULL,&d->nR[r_s+i],&lindep);
850: }
851: } else {
852: for (i=0; i<r_e-r_s; i++) {
853: IPOrthogonalize(d->ipI,0,NULL,d->size_cX,NULL,cX,R[i],NULL,&d->nR[r_s+i],&lindep);
854: }
855: }
856: if (lindep || (PetscAbs(d->nR[r_s+i]) < PETSC_MACHINE_EPSILON)) {
857: PetscInfo2(d->eps,"The computed eigenvector residual %D is too low, %G!\n",r_s+i,d->nR[r_s+i]);
858: }
859: }
860: if (!cX || (cX && d->orthoV_type == EPS_ORTH_BOPT)) {
861: for (i=0;i<r_e-r_s;i++) {
862: VecNormBegin(R[i],NORM_2,&d->nR[r_s+i]);
863: }
864: for (i=0;i<r_e-r_s;i++) {
865: VecNormEnd(R[i],NORM_2,&d->nR[r_s+i]);
866: }
867: }
868: return(0);
869: }
873: /* Compute the residual vectors R(i) <- (AV - BV*eigr(i))*pX(i), and also
874: the norm associated to the eigenpair, where i = r_s..r_e
875: R, vectors of Vec of size r_e-r_s,
876: auxV, PetscMax(r_e+cX_in_H, 2*(r_e-r_s)) vectors,
877: auxS, auxiliar vector of size (d->size_cX+r_e)^2+6(d->size_cX+r_e)+(r_e-r_s)*d->size_H
878: */
879: PetscErrorCode dvd_calcpairs_eig_res_0(dvdDashboard *d,PetscInt r_s,PetscInt r_e,Vec *R)
880: {
881: PetscInt i,size_in,n,ld,ldc,k;
882: PetscErrorCode ierr;
883: Vec *Bx;
884: PetscScalar *cS,*cT,*pcX,*pX,*pX0;
885: DvdReduction r;
886: DvdReductionChunk
887: ops[2];
888: DvdMult_copy_func
889: sr[2];
890: #if !defined(PETSC_USE_COMPLEX)
891: PetscScalar b[8];
892: Vec X[4];
893: #endif
896: /* Quick return */
897: if (!d->cS) return(0);
899: size_in = (d->size_cX+r_e)*(d->cX_in_AV+r_e)*(d->cT?2:1);
900: /* Check consistency */
901: if (d->size_auxV < PetscMax(2*(r_e-r_s),d->cX_in_AV+r_e) || d->size_auxS < PetscMax(d->size_H*(r_e-r_s) /* pX0 */, 2*size_in /* SlepcAllReduceSum */)) SETERRQ(PETSC_COMM_SELF,1, "Consistency broken");
903: /*
904: Compute expanded cS = conv_ps.A, cT = conv_ps.B:
905: conv_ps.A = [ cX'*A*cX cX'*A*X ]
906: [ X'*A*cX X'*A*X ], where cX'*A*cX = cS and X = V*ps.Q
907: */
908: n = d->size_cX+r_e;
909: DSSetDimensions(d->conv_ps,n,0,0,0);
910: DSGetLeadingDimension(d->conv_ps,&ldc);
911: DSGetArray(d->conv_ps,DS_MAT_A,&cS);
912: SlepcDenseCopyTriang(cS,0,ldc,d->cS,0,d->ldcS,d->size_cS,d->size_cS);
913: if (d->cT) {
914: DSGetArray(d->conv_ps,DS_MAT_B,&cT);
915: SlepcDenseCopyTriang(cT,0,ldc,d->cT,0,d->ldcT,d->size_cS,d->size_cS);
916: }
917: DSGetLeadingDimension(d->ps,&ld);
918: DSGetArray(d->ps,DS_MAT_Q,&pX);
919: /* Prepare reductions */
920: SlepcAllReduceSumBegin(ops,2,d->auxS,d->auxS+size_in,size_in,&r,PetscObjectComm((PetscObject)d->V[0]));
921: /* auxV <- A*X = AV * pX(0:r_e+cX_in_H) */
922: SlepcUpdateVectorsZ(d->auxV,0.0,1.0,d->AV-d->cX_in_AV,d->size_AV+d->cX_in_AV,pX,ld,d->size_H,d->cX_in_AV+r_e);
923: /* cS(:, size_cS:) <- cX' * auxV */
924: VecsMultS(&cS[ldc*d->size_cS],0,ldc,d->cY?d->cY:d->cX,0,d->size_cX+r_e,d->auxV,0,d->cX_in_AV+r_e,&r,&sr[0]);
926: if (d->cT) {
927: /* R <- BV * pX(0:r_e+cX_in_H) */
928: SlepcUpdateVectorsZ(d->auxV,0.0,1.0,d->BV-d->cX_in_BV,d->size_BV+d->cX_in_BV,pX,ld,d->size_G,d->cX_in_BV+r_e);
929: /* cT(:, size_cS:) <- cX' * auxV */
930: VecsMultS(&cT[ldc*d->size_cT],0,ldc,d->cY?d->cY:d->cX,0,d->size_cY+r_e,d->auxV,0,d->cX_in_BV+r_e,&r,&sr[1]);
931: }
932: /* Do reductions */
933: SlepcAllReduceSumEnd(&r);
935: DSRestoreArray(d->conv_ps,DS_MAT_A,&cS);
936: if (d->cT) {
937: DSRestoreArray(d->conv_ps,DS_MAT_B,&cT);
938: }
939: DSSetState(d->conv_ps,DS_STATE_INTERMEDIATE);
940: /* eig(S,T) */
941: k = d->size_cX+r_s;
942: DSVectors(d->conv_ps,DS_MAT_X,&k,NULL);
943: DSNormalize(d->conv_ps,DS_MAT_X,d->size_cX+r_s);
944: /* pX0 <- ps.Q(0:d->cX_in_AV+r_e-1) * conv_ps.X(size_cX-cX_in_H:) */
945: pX0 = d->auxS;
946: DSGetArray(d->conv_ps,DS_MAT_X,&pcX);
947: SlepcDenseMatProd(pX0,d->size_H,0.0,1.0,&pX[(d->cX_in_AV+r_s)*ld],ld,d->size_H,r_e-r_s,PETSC_FALSE,&pcX[d->size_cX+d->size_cX*ldc],ldc,r_e+d->cX_in_H,r_e-r_s,PETSC_FALSE);
948: DSRestoreArray(d->ps,DS_MAT_Q,&pX);
949: /* auxV <- cX(0:size_cX-cX_in_AV)*conv_ps.X + V*pX0 */
950: SlepcUpdateVectorsZ(d->auxV,0.0,1.0,d->cX,d->size_cX,&pcX[d->size_cX*ldc],ldc,d->size_cX,r_e-r_s);
951: DSRestoreArray(d->conv_ps,DS_MAT_X,&pcX);
952: SlepcUpdateVectorsZ(d->auxV,(d->size_cX-d->cX_in_AV==0)?0.0:1.0,1.0,d->V-d->cX_in_AV,d->size_V+d->cX_in_AV,pX0,d->size_H,d->size_H,r_e-r_s);
953: /* nX <- ||auxV|| */
954: for (i=0;i<r_e-r_s;i++) {
955: VecNormBegin(d->auxV[i],NORM_2,&d->nX[r_s+i]);
956: }
957: for (i=0;i<r_e-r_s;i++) {
958: VecNormEnd(d->auxV[i],NORM_2,&d->nX[r_s+i]);
959: }
960: /* R <- A*auxV */
961: for (i=0; i<r_e-r_s; i++) {
962: MatMult(d->A,d->auxV[i],R[i]);
963: }
964: /* Bx <- B*auxV */
965: if (d->B) {
966: Bx = &d->auxV[r_e-r_s];
967: for (i=0; i<r_e-r_s; i++) {
968: MatMult(d->B,d->auxV[i],Bx[i]);
969: }
970: } else Bx = d->auxV;
971: /* R <- (A - eig*B)*V*pX */
972: for (i=0;i<r_e-r_s;i++) {
973: #if !defined(PETSC_USE_COMPLEX)
974: if (d->eigi[r_s+i] != 0.0) {
975: /* [Ax_i Ax_i+1 Bx_i Bx_i+1]*= [ 1 0
976: 0 1
977: -eigr_i -eigi_i
978: eigi_i -eigr_i] */
979: b[0] = b[5] = 1.0;
980: b[2] = b[7] = -d->eigr[r_s+i];
981: b[6] = -(b[3] = d->eigi[r_s+i]);
982: b[1] = b[4] = 0.0;
983: X[0] = R[i]; X[1] = R[i+1]; X[2] = Bx[i]; X[3] = Bx[i+1];
984: SlepcUpdateVectorsD(X,4,1.0,b,4,4,2,d->auxS,d->size_auxS);
985: i++;
986: } else
987: #endif
988: {
989: /* R <- Ax -eig*Bx */
990: VecAXPBY(R[i], -d->eigr[r_s+i], 1.0, Bx[i]);
991: }
992: }
993: /* nR <- ||R|| */
994: for (i=0;i<r_e-r_s;i++) {
995: VecNormBegin(R[i],NORM_2,&d->nR[r_s+i]);
996: }
997: for (i=0;i<r_e-r_s;i++) {
998: VecNormEnd(R[i],NORM_2,&d->nR[r_s+i]);
999: }
1000: return(0);
1001: }
1004: /**** Pattern routines ********************************************************/
1006: /* BV <- BV*MT */
1009: PETSC_STATIC_INLINE PetscErrorCode dvd_calcpairs_updateBV0_gen(dvdDashboard *d,Vec *real_BV,PetscInt *size_cBV,Vec **BV,PetscInt *size_BV,PetscInt *max_size_BV,PetscBool BV_shift,PetscInt *cX_in_proj,DSMatType mat)
1010: {
1011: PetscErrorCode ierr;
1012: PetscInt cMT,rm,cp,tra_s,i,ld;
1013: Vec *nBV;
1014: PetscScalar *MT;
1017: if (!real_BV || !*BV || (d->V_tra_s == 0 && d->V_tra_e == 0)) return(0);
1019: DSGetLeadingDimension(d->ps,&ld);
1020: DSGetArray(d->ps,mat,&MT);
1021: if (d->V_tra_s > d->max_cX_in_proj && !BV_shift) {
1022: tra_s = PetscMax(d->V_tra_s-d->max_cX_in_proj, 0);
1023: cMT = d->V_tra_e - tra_s;
1024: rm = d->V_tra_s - tra_s;
1025: cp = PetscMin(d->max_cX_in_proj - rm, *cX_in_proj);
1026: nBV = real_BV+d->max_cX_in_proj;
1027: /* BV(-cp-rm:-1-rm) <- BV(-cp:-1) */
1028: for (i=-cp; i<0; i++) {
1029: VecCopy((*BV)[i], nBV[i-rm]);
1030: }
1031: /* BV(-rm:) <- BV*MT(tra_s:V_tra_e-1) */
1032: SlepcUpdateVectorsZ(&nBV[-rm],0.0,1.0,*BV-*cX_in_proj,*size_BV+*cX_in_proj,&MT[ld*tra_s],ld,d->size_MT,cMT);
1033: *size_BV = d->V_tra_e - d->V_tra_s;
1034: *max_size_BV-= nBV - *BV;
1035: *BV = nBV;
1036: if (cX_in_proj && d->max_cX_in_proj>0) *cX_in_proj = cp+rm;
1037: } else if (d->V_tra_s <= d->max_cX_in_proj || BV_shift) {
1038: /* [BcX BV] <- [BcX BV*MT] */
1039: SlepcUpdateVectorsZ(*BV-*cX_in_proj,0.0,1.0,*BV-*cX_in_proj,*size_BV+*cX_in_proj,MT,ld,d->size_MT,d->V_tra_e);
1040: *BV+= d->V_tra_s-*cX_in_proj;
1041: *max_size_BV-= d->V_tra_s-*cX_in_proj;
1042: *size_BV = d->V_tra_e - d->V_tra_s;
1043: if (size_cBV && BV_shift) *size_cBV = *BV - real_BV;
1044: if (d->max_cX_in_proj>0) *cX_in_proj = PetscMin(*BV - real_BV, d->max_cX_in_proj);
1045: } else { /* !BV_shift */
1046: /* BV <- BV*MT(V_tra_s:) */
1047: SlepcUpdateVectorsZ(*BV,0.0,1.0,*BV,*size_BV,&MT[d->V_tra_s*ld],ld,d->size_MT,d->V_tra_e-d->V_tra_s);
1048: *size_BV = d->V_tra_e - d->V_tra_s;
1049: }
1050: DSRestoreArray(d->ps,mat,&MT);
1051: return(0);
1052: }