Date: 2013-09-02T10:03:51+00:00

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