Date: 2016-03-29T14:58:02+00:00

Actual source code: dvdcalcpairs.c
slepc-3.6.3 2016-03-29
Report Typos and Errors

      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-2015, 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>

     38: static PetscErrorCode dvd_calcpairs_qz_start(dvdDashboard *d)
     39: {

     43:   BVSetActiveColumns(d->eps->V,0,0);
     44:   if (d->W) { BVSetActiveColumns(d->W,0,0); }
     45:   BVSetActiveColumns(d->AX,0,0);
     46:   if (d->BX) { BVSetActiveColumns(d->BX,0,0); }
     47:   return(0);
     48: }

     52: static PetscErrorCode dvd_calcpairs_qz_d(dvdDashboard *d)
     53: {
     54:   PetscErrorCode  ierr;

     57:   BVDestroy(&d->W);
     58:   BVDestroy(&d->AX);
     59:   BVDestroy(&d->BX);
     60:   BVDestroy(&d->auxBV);
     61:   MatDestroy(&d->H);
     62:   if (d->G) { MatDestroy(&d->G); }
     63:   MatDestroy(&d->auxM);
     64:   SlepcVecPoolDestroy(&d->auxV);
     65:   PetscFree(d->nBds);
     66:   return(0);
     67: }

     69: /* in complex, d->size_H real auxiliar values are needed */
     72: static PetscErrorCode dvd_calcpairs_projeig_solve(dvdDashboard *d)
     73: {
     74:   PetscErrorCode    ierr;
     75:   Vec               v;
     76:   PetscScalar       *pA;
     77:   const PetscScalar *pv;
     78:   PetscInt          i,lV,kV,n,ld;

     81:   BVGetActiveColumns(d->eps->V,&lV,&kV);
     82:   n = kV-lV;
     83:   DSSetDimensions(d->eps->ds,n,0,0,0);
     84:   DSCopyMat(d->eps->ds,DS_MAT_A,0,0,d->H,lV,lV,n,n,PETSC_FALSE);
     85:   if (d->G) {
     86:     DSCopyMat(d->eps->ds,DS_MAT_B,0,0,d->G,lV,lV,n,n,PETSC_FALSE);
     87:   }
     88:   /* Set the signature on projected matrix B */
     89:   if (DVD_IS(d->sEP,DVD_EP_INDEFINITE)) {
     90:     DSGetLeadingDimension(d->eps->ds,&ld);
     91:     DSGetArray(d->eps->ds,DS_MAT_B,&pA);
     92:     PetscMemzero(pA,sizeof(PetscScalar)*n*ld);
     93:     VecCreateSeq(PETSC_COMM_SELF,kV,&v);
     94:     BVGetSignature(d->eps->V,v);
     95:     VecGetArrayRead(v,&pv);
     96:     for (i=0;i<n;i++) {
     97:       pA[i+ld*i] = d->nBds[i] = PetscRealPart(pv[lV+i]);
     98:     }
     99:     VecRestoreArrayRead(v,&pv);
    100:     VecDestroy(&v);
    101:     DSRestoreArray(d->eps->ds,DS_MAT_B,&pA);
    102:   }
    103:   DSSetState(d->eps->ds,DS_STATE_RAW);
    104:   DSSolve(d->eps->ds,d->eigr,d->eigi);
    105:   return(0);
    106: }

    110: /*
    111:    A(lA:kA-1,lA:kA-1) <- Z(l:k-1)'*A(l:k-1,l:k-1)*Q(l,k-1), where k=l+kA-lA
    112:  */
    113: static PetscErrorCode EPSXDUpdateProj(Mat Q,Mat Z,PetscInt l,Mat A,PetscInt lA,PetscInt kA,Mat aux)
    114: {
    116:   PetscScalar    one=1.0,zero=0.0;
    117:   PetscInt       i,j,dA_=kA-lA,m0,n0,ldA_,ldQ_,ldZ_,nQ_;
    118:   PetscBLASInt   dA,nQ,ldA,ldQ,ldZ;
    119:   PetscScalar    *pA,*pQ,*pZ,*pW;
    120:   PetscBool      symm=PETSC_FALSE,set,flg;

    123:   MatGetSize(A,&m0,&n0); ldA_=m0;
    124:   if (m0!=n0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"A should be square");
    125:   if (lA<0 || lA>m0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Invalid initial row, column in A");
    126:   if (kA<0 || kA<lA || kA>m0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Invalid final row, column in A");
    127:   MatIsHermitianKnown(A,&set,&flg);
    128:   symm = set? flg: PETSC_FALSE;
    129:   MatGetSize(Q,&m0,&n0); ldQ_=nQ_=m0;
    130:   if (l<0 || l>n0 || l+dA_>n0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Invalid initial column in Q");
    131:   MatGetSize(Z,&m0,&n0); ldZ_=m0;
    132:   if (l<0 || l>n0 || l+dA_>n0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Invalid initial column in Z");
    133:   MatGetSize(aux,&m0,&n0);
    134:   if (m0*n0<nQ_*dA_) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"aux should be larger");
    135:   PetscBLASIntCast(dA_,&dA);
    136:   PetscBLASIntCast(nQ_,&nQ);
    137:   PetscBLASIntCast(ldA_,&ldA);
    138:   PetscBLASIntCast(ldQ_,&ldQ);
    139:   PetscBLASIntCast(ldZ_,&ldZ);
    140:   MatDenseGetArray(A,&pA);
    141:   MatDenseGetArray(Q,&pQ);
    142:   if (Q!=Z) { MatDenseGetArray(Z,&pZ); }
    143:   else pZ = pQ;
    144: #if PETSC_USE_DEBUG
    145:   /* Avoid valgrind warning in xgemm and xsymm */
    146:   MatZeroEntries(aux);
    147: #endif
    148:   MatDenseGetArray(aux,&pW);
    149:   /* W = A*Q */
    150:   if (symm) {
    151:     /* symmetrize before multiplying */
    152:     for (i=lA+1;i<lA+nQ;i++) {
    153:       for (j=lA;j<i;j++) pA[i+j*ldA] = PetscConj(pA[j+i*ldA]);
    154:     }
    155:   }
    156:   PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&nQ,&dA,&nQ,&one,&pA[ldA*lA+lA],&ldA,&pQ[ldQ*l+l],&ldQ,&zero,pW,&nQ));
    157:   /* A = Q'*W */
    158:   PetscStackCallBLAS("BLASgemm",BLASgemm_("C","N",&dA,&dA,&nQ,&one,&pZ[ldZ*l+l],&ldZ,pW,&nQ,&zero,&pA[ldA*lA+lA],&ldA));
    159:   MatDenseGetArray(A,&pA);
    160:   MatDenseGetArray(Q,&pQ);
    161:   if (Q!=Z) { MatDenseGetArray(Z,&pZ); }
    162:   else pZ = pQ;
    163:   MatDenseGetArray(aux,&pW);
    164:   return(0);
    165: }

    169: static PetscErrorCode dvd_calcpairs_updateproj(dvdDashboard *d)
    170: {
    172:   Mat            Q,Z;
    173:   PetscInt       lV,kV;
    174:   PetscBool      symm;

    177:   DSGetMat(d->eps->ds,DS_MAT_Q,&Q);
    178:   if (d->W) { DSGetMat(d->eps->ds,DS_MAT_Z,&Z); }
    179:   else Z = Q;
    180:   BVGetActiveColumns(d->eps->V,&lV,&kV);
    181:   EPSXDUpdateProj(Q,Z,0,d->H,lV,lV+d->V_tra_e,d->auxM);
    182:   if (d->G) { EPSXDUpdateProj(Q,Z,0,d->G,lV,lV+d->V_tra_e,d->auxM); }
    183:   DSRestoreMat(d->eps->ds,DS_MAT_Q,&Q);
    184:   if (d->W) { DSRestoreMat(d->eps->ds,DS_MAT_Z,&Z); }

    186:   PetscObjectTypeCompareAny((PetscObject)d->eps->ds,&symm,DSHEP,DSGHIEP,"");
    187:   if (d->V_tra_s==0 || symm) return(0);
    188:   /* Compute upper part of H (and G): H(0:l-1,l:k-1) <- W(0:l-1)' * AV(l:k-1), where
    189:      k=l+d->V_tra_s */
    190:   BVSetActiveColumns(d->W?d->W:d->eps->V,0,lV);
    191:   BVSetActiveColumns(d->AX,lV,lV+d->V_tra_s);
    192:   BVDot(d->AX,d->W?d->W:d->eps->V,d->H);
    193:   if (d->G) {
    194:     BVSetActiveColumns(d->BX?d->BX:d->eps->V,lV,lV+d->V_tra_s);
    195:     BVDot(d->BX?d->BX:d->eps->V,d->W?d->W:d->eps->V,d->G);
    196:   }
    197:   PetscObjectTypeCompareAny((PetscObject)d->eps->ds,&symm,DSGHEP,"");
    198:   if (!symm) {
    199:     BVSetActiveColumns(d->W?d->W:d->eps->V,lV,lV+d->V_tra_s);
    200:     BVSetActiveColumns(d->AX,0,lV);
    201:     BVDot(d->AX,d->W?d->W:d->eps->V,d->H);
    202:     if (d->G) {
    203:       BVSetActiveColumns(d->BX?d->BX:d->eps->V,0,lV);
    204:       BVDot(d->BX?d->BX:d->eps->V,d->W?d->W:d->eps->V,d->G);
    205:     }
    206:   }
    207:   BVSetActiveColumns(d->eps->V,lV,kV);
    208:   BVSetActiveColumns(d->AX,lV,kV);
    209:   if (d->BX) { BVSetActiveColumns(d->BX,lV,kV); }
    210:   if (d->W) { BVSetActiveColumns(d->W,lV,kV); }
    211:   if (d->W) { dvd_harm_updateproj(d); }
    212:   return(0);
    213: }

    217: /*
    218:    BV <- BV*MT
    219:  */
    220: PETSC_STATIC_INLINE PetscErrorCode dvd_calcpairs_updateBV0_gen(dvdDashboard *d,BV bv,DSMatType mat)
    221: {
    223:   PetscInt       l,k,n;
    224:   Mat            auxM;

    227:   BVGetActiveColumns(d->eps->V,&l,&k);
    228:   MatCreateSeqDense(PETSC_COMM_SELF,k,k,NULL,&auxM);
    229:   MatZeroEntries(auxM);
    230:   DSGetDimensions(d->eps->ds,&n,NULL,NULL,NULL,NULL);
    231:   if (k-l!=n) SETERRQ(PETSC_COMM_SELF,1, "Consistency broken");
    232:   DSCopyMat(d->eps->ds,mat,0,0,auxM,l,l,n,d->V_tra_e,PETSC_TRUE);
    233:   BVMultInPlace(bv,auxM,l,l+d->V_tra_e);
    234:   MatDestroy(&auxM);
    235:   return(0);
    236: }

    240: static PetscErrorCode dvd_calcpairs_proj(dvdDashboard *d)
    241: {
    243:   PetscInt       i,l,k;
    244:   Vec            v1,v2;
    245:   PetscScalar    *pv;

    248:   BVGetActiveColumns(d->eps->V,&l,&k);
    249:   /* Update AV, BV, W and the projected matrices */
    250:   /* 1. S <- S*MT */
    251:   if (d->V_tra_s != d->V_tra_e) {
    252:     dvd_calcpairs_updateBV0_gen(d,d->eps->V,DS_MAT_Q);
    253:     if (d->W) { dvd_calcpairs_updateBV0_gen(d,d->W,DS_MAT_Z); }
    254:     dvd_calcpairs_updateBV0_gen(d,d->AX,DS_MAT_Q);
    255:     if (d->BX) { dvd_calcpairs_updateBV0_gen(d,d->BX,DS_MAT_Q); }
    256:     dvd_calcpairs_updateproj(d);
    257:     /* Update signature */
    258:     if (d->nBds) {
    259:       VecCreateSeq(PETSC_COMM_SELF,l+d->V_tra_e,&v1);
    260:       BVSetActiveColumns(d->eps->V,0,l+d->V_tra_e);
    261:       BVGetSignature(d->eps->V,v1);
    262:       VecGetArray(v1,&pv);
    263:       for (i=0;i<d->V_tra_e;i++) pv[l+i] = d->nBds[i];
    264:       VecRestoreArray(v1,&pv);
    265:       BVSetSignature(d->eps->V,v1);
    266:       BVSetActiveColumns(d->eps->V,l,k);
    267:       VecDestroy(&v1);
    268:     }
    269:     k = l+d->V_tra_e;
    270:     l+= d->V_tra_s;
    271:   } else {
    272:     /* 2. V <- orth(V, V_new) */
    273:     dvd_orthV(d->eps->V,l+d->V_new_s,l+d->V_new_e,d->eps->rand);
    274:     /* 3. AV <- [AV A * V(V_new_s:V_new_e-1)] */
    275:     /* Check consistency */
    276:     if (k-l != d->V_new_s) SETERRQ(PETSC_COMM_SELF,1, "Consistency broken");
    277:     for (i=l+d->V_new_s;i<l+d->V_new_e;i++) {
    278:       BVGetColumn(d->eps->V,i,&v1);
    279:       BVGetColumn(d->AX,i,&v2);
    280:       MatMult(d->A,v1,v2);
    281:       BVRestoreColumn(d->eps->V,i,&v1);
    282:       BVRestoreColumn(d->AX,i,&v2);
    283:     }
    284:     /* 4. BV <- [BV B * V(V_new_s:V_new_e-1)] */
    285:     if (d->BX) {
    286:       /* Check consistency */
    287:       if (k-l != d->V_new_s) SETERRQ(PETSC_COMM_SELF,1, "Consistency broken");
    288:       for (i=l+d->V_new_s;i<l+d->V_new_e;i++) {
    289:         BVGetColumn(d->eps->V,i,&v1);
    290:         BVGetColumn(d->BX,i,&v2);
    291:         MatMult(d->B,v1,v2);
    292:         BVRestoreColumn(d->eps->V,i,&v1);
    293:         BVRestoreColumn(d->BX,i,&v2);
    294:       }
    295:     }
    296:     /* 5. W <- [W f(AV,BV)] */
    297:     if (d->W) {
    298:       d->calcpairs_W(d);
    299:       dvd_orthV(d->W,l+d->V_new_s,l+d->V_new_e,d->eps->rand);
    300:     }
    301:     /* 6. H <- W' * AX; G <- W' * BX */
    302:     BVSetActiveColumns(d->eps->V,l+d->V_new_s,l+d->V_new_e);
    303:     BVSetActiveColumns(d->AX,l+d->V_new_s,l+d->V_new_e);
    304:     if (d->BX) { BVSetActiveColumns(d->BX,l+d->V_new_s,l+d->V_new_e); }
    305:     if (d->W) { BVSetActiveColumns(d->W,l+d->V_new_s,l+d->V_new_e); }
    306:     BVMatProject(d->AX,NULL,d->W?d->W:d->eps->V,d->H);
    307:     if (d->G) { BVMatProject(d->BX?d->BX:d->eps->V,NULL,d->W?d->W:d->eps->V,d->G); }
    308:     BVSetActiveColumns(d->eps->V,l,k);
    309:     BVSetActiveColumns(d->AX,l,k);
    310:     if (d->BX) { BVSetActiveColumns(d->BX,l,k); }
    311:     if (d->W) { BVSetActiveColumns(d->W,l,k); }

    313:     /* Perform the transformation on the projected problem */
    314:     if (d->W) {
    315:       d->calcpairs_proj_trans(d);
    316:     }
    317:     k = l+d->V_new_e;
    318:   }
    319:   BVSetActiveColumns(d->eps->V,l,k);
    320:   BVSetActiveColumns(d->AX,l,k);
    321:   if (d->BX) { BVSetActiveColumns(d->BX,l,k); }
    322:   if (d->W) { BVSetActiveColumns(d->W,l,k); }

    324:   /* Solve the projected problem */
    325:   dvd_calcpairs_projeig_solve(d);

    327:   d->V_tra_s = d->V_tra_e = 0;
    328:   d->V_new_s = d->V_new_e;
    329:   return(0);
    330: }

    334: static PetscErrorCode dvd_calcpairs_apply_arbitrary(dvdDashboard *d,PetscInt r_s,PetscInt r_e,PetscScalar *rr,PetscScalar *ri)
    335: {
    336:   PetscInt       i,k,ld;
    337:   PetscScalar    *pX;
    338:   Vec            *X,xr,xi;
    340: #if defined(PETSC_USE_COMPLEX)
    341:   PetscInt       N=1;
    342: #else
    343:   PetscInt       N=2,j;
    344: #endif

    347:   /* Quick exit without neither arbitrary selection nor harmonic extraction */
    348:   if (!d->eps->arbitrary && !d->calcpairs_eig_backtrans) return(0);

    350:   /* Quick exit without arbitrary selection, but with harmonic extraction */
    351:   if (d->calcpairs_eig_backtrans) {
    352:     for (i=r_s; i<r_e; i++) {
    353:       d->calcpairs_eig_backtrans(d,d->eigr[i],d->eigi[i],&rr[i-r_s],&ri[i-r_s]);
    354:     }
    355:   }
    356:   if (!d->eps->arbitrary) return(0);

    358:   SlepcVecPoolGetVecs(d->auxV,N,&X);
    359:   DSGetLeadingDimension(d->eps->ds,&ld);
    360:   for (i=r_s;i<r_e;i++) {
    361:     k = i;
    362:     DSVectors(d->eps->ds,DS_MAT_X,&k,NULL);
    363:     DSNormalize(d->eps->ds,DS_MAT_X,i);
    364:     DSGetArray(d->eps->ds,DS_MAT_X,&pX);
    365:     dvd_improvex_compute_X(d,i,k+1,X,pX,ld);
    366:     DSRestoreArray(d->eps->ds,DS_MAT_X,&pX);
    367: #if !defined(PETSC_USE_COMPLEX)
    368:     if (d->nX[i] != 1.0) {
    369:       for (j=i;j<k+1;j++) {
    370:         VecScale(X[j-i],1.0/d->nX[i]);
    371:       }
    372:     }
    373:     xr = X[0];
    374:     xi = X[1];
    375:     if (i == k) {
    376:       VecSet(xi,0.0);
    377:     }
    378: #else
    379:     xr = X[0];
    380:     xi = NULL;
    381:     if (d->nX[i] != 1.0) {
    382:       VecScale(xr,1.0/d->nX[i]);
    383:     }
    384: #endif
    385:     (d->eps->arbitrary)(rr[i-r_s],ri[i-r_s],xr,xi,&rr[i-r_s],&ri[i-r_s],d->eps->arbitraryctx);
    386: #if !defined(PETSC_USE_COMPLEX)
    387:     if (i != k) {
    388:       rr[i+1-r_s] = rr[i-r_s];
    389:       ri[i+1-r_s] = ri[i-r_s];
    390:       i++;
    391:     }
    392: #endif
    393:   }
    394:   SlepcVecPoolRestoreVecs(d->auxV,N,&X);
    395:   return(0);
    396: }

    400: static PetscErrorCode dvd_calcpairs_selectPairs(dvdDashboard *d,PetscInt n)
    401: {
    402:   PetscInt       k,lV,kV,nV;
    403:   PetscScalar    *rr,*ri;

    407:   BVGetActiveColumns(d->eps->V,&lV,&kV);
    408:   nV = kV - lV;
    409:   n = PetscMin(n,nV);
    410:   /* Put the best n pairs at the beginning. Useful for restarting */
    411:   if (d->eps->arbitrary || d->calcpairs_eig_backtrans) {
    412:     PetscMalloc1(nV,&rr);
    413:     PetscMalloc1(nV,&ri);
    414:     dvd_calcpairs_apply_arbitrary(d,0,nV,rr,ri);
    415:   } else {
    416:     rr = d->eigr;
    417:     ri = d->eigi;
    418:   }
    419:   k = n;
    420:   DSSort(d->eps->ds,d->eigr,d->eigi,rr,ri,&k);
    421:   /* Put the best pair at the beginning. Useful to check its residual */
    422: #if !defined(PETSC_USE_COMPLEX)
    423:   if (n != 1 && (n != 2 || d->eigi[0] == 0.0))
    424: #else
    425:   if (n != 1)
    426: #endif
    427:   {
    428:     dvd_calcpairs_apply_arbitrary(d,0,nV,rr,ri);
    429:     k = 1;
    430:     DSSort(d->eps->ds,d->eigr,d->eigi,rr,ri,&k);
    431:   }
    432:   if (d->calcpairs_eigs_trans) {
    433:     d->calcpairs_eigs_trans(d);
    434:   }
    435:   if (d->eps->arbitrary || d->calcpairs_eig_backtrans) {
    436:     PetscFree(rr);
    437:     PetscFree(ri);
    438:   }
    439:   return(0);
    440: }

    444: static PetscErrorCode EPSXDComputeDSConv(dvdDashboard *d)
    445: {
    446:   PetscErrorCode    ierr;
    447:   PetscInt          i,ld;
    448:   Vec               v;
    449:   PetscScalar       *pA;
    450:   const PetscScalar *pv;
    451:   PetscBool         symm;

    454:   BVSetActiveColumns(d->eps->V,0,d->eps->nconv);
    455:   PetscObjectTypeCompareAny((PetscObject)d->eps->ds,&symm,DSHEP,"");
    456:   if (symm) return(0);
    457:   DSSetDimensions(d->eps->ds,d->eps->nconv,0,0,0);
    458:   DSCopyMat(d->eps->ds,DS_MAT_A,0,0,d->H,0,0,d->eps->nconv,d->eps->nconv,PETSC_FALSE);
    459:   if (d->G) {
    460:     DSCopyMat(d->eps->ds,DS_MAT_B,0,0,d->G,0,0,d->eps->nconv,d->eps->nconv,PETSC_FALSE);
    461:   }
    462:   /* Set the signature on projected matrix B */
    463:   if (DVD_IS(d->sEP,DVD_EP_INDEFINITE)) {
    464:     DSGetLeadingDimension(d->eps->ds,&ld);
    465:     DSGetArray(d->eps->ds,DS_MAT_B,&pA);
    466:     PetscMemzero(pA,sizeof(PetscScalar)*d->eps->nconv*ld);
    467:     VecCreateSeq(PETSC_COMM_SELF,d->eps->nconv,&v);
    468:     BVGetSignature(d->eps->V,v);
    469:     VecGetArrayRead(v,&pv);
    470:     for (i=0;i<d->eps->nconv;i++) pA[i+ld*i] = pv[i];
    471:     VecRestoreArrayRead(v,&pv);
    472:     VecDestroy(&v);
    473:     DSRestoreArray(d->eps->ds,DS_MAT_B,&pA);
    474:   }
    475:   DSSetState(d->eps->ds,DS_STATE_RAW);
    476:   DSSolve(d->eps->ds,d->eps->eigr,d->eps->eigi);
    477:   if (d->W) {
    478:     for (i=0; i<d->eps->nconv; i++) {
    479:       d->calcpairs_eig_backtrans(d,d->eps->eigr[i],d->eps->eigi[i],&d->eps->eigr[i],&d->eps->eigi[i]);
    480:     }
    481:   }
    482:   return(0);
    483: }

    487: /*
    488:    Compute the residual vectors R(i) <- (AV - BV*eigr(i))*pX(i), and also
    489:    the norm associated to the Schur pair, where i = r_s..r_e
    490: */
    491: static PetscErrorCode dvd_calcpairs_res_0(dvdDashboard *d,PetscInt r_s,PetscInt r_e)
    492: {
    493:   PetscInt       i,ldpX;
    494:   PetscScalar    *pX;
    496:   BV             BX = d->BX?d->BX:d->eps->V;
    497:   Vec            *R;

    500:   DSGetLeadingDimension(d->eps->ds,&ldpX);
    501:   DSGetArray(d->eps->ds,DS_MAT_Q,&pX);
    502:   /* nX(i) <- ||X(i)|| */
    503:   dvd_improvex_compute_X(d,r_s,r_e,NULL,pX,ldpX);
    504:   SlepcVecPoolGetVecs(d->auxV,r_e-r_s,&R);
    505:   for (i=r_s;i<r_e;i++) {
    506:     /* R(i-r_s) <- AV*pX(i) */
    507:     BVMultVec(d->AX,1.0,0.0,R[i-r_s],&pX[ldpX*i]);
    508:     /* R(i-r_s) <- R(i-r_s) - eigr(i)*BX*pX(i) */
    509:     BVMultVec(BX,-d->eigr[i],1.0,R[i-r_s],&pX[ldpX*i]);
    510:   }
    511:   DSRestoreArray(d->eps->ds,DS_MAT_Q,&pX);
    512:   d->calcpairs_proj_res(d,r_s,r_e,R);
    513:   SlepcVecPoolRestoreVecs(d->auxV,r_e-r_s,&R);
    514:   return(0);
    515: }

    519: static PetscErrorCode dvd_calcpairs_proj_res(dvdDashboard *d,PetscInt r_s,PetscInt r_e,Vec *R)
    520: {
    521:   PetscInt       i,l,k;
    523:   PetscBool      lindep;
    524:   BV             cX;

    527:   if (d->W) cX = d->W; /* If left subspace exists, R <- orth(cY, R), nR[i] <- ||R[i]|| */
    528:   else if (!(DVD_IS(d->sEP, DVD_EP_STD) && DVD_IS(d->sEP, DVD_EP_HERMITIAN))) cX = d->eps->V; /* If not HEP, R <- orth(cX, R), nR[i] <- ||R[i]|| */
    529:   else cX = NULL; /* Otherwise, nR[i] <- ||R[i]|| */

    531:   if (cX) {
    532:     BVGetActiveColumns(cX,&l,&k);
    533:     BVSetActiveColumns(cX,0,l);
    534:     for (i=0;i<r_e-r_s;i++) {
    535:       BVOrthogonalizeVec(cX,R[i],NULL,&d->nR[r_s+i],&lindep);
    536:     }
    537:     BVSetActiveColumns(cX,l,k);
    538:     if (lindep || (PetscAbs(d->nR[r_s+i]) < PETSC_MACHINE_EPSILON)) {
    539:       PetscInfo2(d->eps,"The computed eigenvector residual %D is too low, %g!\n",r_s+i,(double)(d->nR[r_s+i]));
    540:     }
    541:   } else {
    542:     for (i=0;i<r_e-r_s;i++) {
    543:       VecNormBegin(R[i],NORM_2,&d->nR[r_s+i]);
    544:     }
    545:     for (i=0;i<r_e-r_s;i++) {
    546:       VecNormEnd(R[i],NORM_2,&d->nR[r_s+i]);
    547:     }
    548:   }
    549:   return(0);
    550: }

    554: PetscErrorCode dvd_calcpairs_qz(dvdDashboard *d,dvdBlackboard *b,PetscBool borth,PetscInt cX_proj,PetscBool harm)
    555: {
    557:   PetscBool      std_probl,her_probl,ind_probl,her_ind_probl;
    558:   DSType         dstype;
    559:   Vec            v1;

    562:   std_probl = DVD_IS(d->sEP,DVD_EP_STD)? PETSC_TRUE: PETSC_FALSE;
    563:   her_probl = DVD_IS(d->sEP,DVD_EP_HERMITIAN)? PETSC_TRUE: PETSC_FALSE;
    564:   ind_probl = DVD_IS(d->sEP,DVD_EP_INDEFINITE)? PETSC_TRUE: PETSC_FALSE;
    565:   her_ind_probl = (her_probl||ind_probl)? PETSC_TRUE: PETSC_FALSE;

    567:   /* Setting configuration constrains */
    568:   b->max_size_proj = PetscMax(b->max_size_proj,b->max_size_V+cX_proj);
    569:   d->W_shift = d->B? PETSC_TRUE: PETSC_FALSE;
    570:   if (d->B && her_ind_probl && !borth) d->BV_shift = PETSC_TRUE;
    571:   else d->BV_shift = PETSC_FALSE;

    573:   /* Setup the step */
    574:   if (b->state >= DVD_STATE_CONF) {
    575:     d->max_cX_in_proj = cX_proj;
    576:     d->max_size_P = b->max_size_P;
    577:     d->max_size_proj = b->max_size_proj;
    578:     /* Create a DS if the method works with Schur decompositions */
    579:     d->calcPairs = dvd_calcpairs_proj;
    580:     d->calcpairs_residual = dvd_calcpairs_res_0;
    581:     d->calcpairs_proj_res = dvd_calcpairs_proj_res;
    582:     d->calcpairs_selectPairs = dvd_calcpairs_selectPairs;
    583:     /* Create and configure a DS for solving the projected problems */
    584:     if (d->W) dstype = DSGNHEP;    /* If we use harmonics */
    585:     else {
    586:       if (ind_probl) dstype = DSGHIEP;
    587:       else if (std_probl) dstype = her_probl? DSHEP : DSNHEP;
    588:       else dstype = her_probl? DSGHEP : DSGNHEP;
    589:     }
    590:     DSSetType(d->eps->ds,dstype);
    591:     DSAllocate(d->eps->ds,d->eps->ncv);
    592:     /* Create various vector basis */
    593:     if (harm) {
    594:       BVDuplicateResize(d->eps->V,d->eps->ncv,&d->W);
    595:       BVSetMatrix(d->W,NULL,PETSC_FALSE);
    596:     } else d->W = NULL;
    597:     BVDuplicateResize(d->eps->V,d->eps->ncv,&d->AX);
    598:     BVSetMatrix(d->AX,NULL,PETSC_FALSE);
    599:     BVDuplicateResize(d->eps->V,d->eps->ncv,&d->auxBV);
    600:     BVSetMatrix(d->auxBV,NULL,PETSC_FALSE);
    601:     if (d->B) {
    602:       BVDuplicateResize(d->eps->V,d->eps->ncv,&d->BX);
    603:       BVSetMatrix(d->BX,NULL,PETSC_FALSE);
    604:     } else d->BX = NULL;
    605:     MatCreateVecs(d->A,&v1,NULL);
    606:     SlepcVecPoolCreate(v1,0,&d->auxV);
    607:     VecDestroy(&v1);
    608:     /* Create projected problem matrices */
    609:     MatCreateSeqDense(PETSC_COMM_SELF,d->eps->ncv,d->eps->ncv,NULL,&d->H);
    610:     if (!std_probl) {
    611:       MatCreateSeqDense(PETSC_COMM_SELF,d->eps->ncv,d->eps->ncv,NULL,&d->G);
    612:     } else d->G = NULL;
    613:     if (her_probl) {
    614:       MatSetOption(d->H,MAT_HERMITIAN,PETSC_TRUE);
    615:       if (d->G) { MatSetOption(d->G,MAT_HERMITIAN,PETSC_TRUE); }
    616:     }

    618:     if (ind_probl) {
    619:       PetscMalloc1(d->eps->ncv,&d->nBds);
    620:     } else d->nBds = NULL;
    621:     MatCreateSeqDense(PETSC_COMM_SELF,d->eps->ncv,d->eps->ncv,NULL,&d->auxM);

    623:     EPSDavidsonFLAdd(&d->startList,dvd_calcpairs_qz_start);
    624:     EPSDavidsonFLAdd(&d->endList,EPSXDComputeDSConv);
    625:     EPSDavidsonFLAdd(&d->destroyList,dvd_calcpairs_qz_d);
    626:   }
    627:   return(0);
    628: }