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