Actual source code: dvdcalcpairs.c

      1: /*
      2:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      3:    SLEPc - Scalable Library for Eigenvalue Problem Computations
      4:    Copyright (c) 2002-, Universitat Politecnica de Valencia, Spain

      6:    This file is part of SLEPc.
      7:    SLEPc is distributed under a 2-clause BSD license (see LICENSE).
      8:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      9: */
     10: /*
     11:    SLEPc eigensolver: "davidson"

     13:    Step: calculate the best eigenpairs in the subspace V

     15:    For that, performs these steps:
     16:      1) Update W <- A * V
     17:      2) Update H <- V' * W
     18:      3) Obtain eigenpairs of H
     19:      4) Select some eigenpairs
     20:      5) Compute the Ritz pairs of the selected ones
     21: */

     23: #include "davidson.h"
     24: #include <slepcblaslapack.h>

     26: static PetscErrorCode dvd_calcpairs_qz_start(dvdDashboard *d)
     27: {
     28:   PetscFunctionBegin;
     29:   PetscCall(BVSetActiveColumns(d->eps->V,0,0));
     30:   if (d->W) PetscCall(BVSetActiveColumns(d->W,0,0));
     31:   PetscCall(BVSetActiveColumns(d->AX,0,0));
     32:   if (d->BX) PetscCall(BVSetActiveColumns(d->BX,0,0));
     33:   PetscFunctionReturn(PETSC_SUCCESS);
     34: }

     36: static PetscErrorCode dvd_calcpairs_qz_d(dvdDashboard *d)
     37: {
     38:   PetscFunctionBegin;
     39:   PetscCall(BVDestroy(&d->W));
     40:   PetscCall(BVDestroy(&d->AX));
     41:   PetscCall(BVDestroy(&d->BX));
     42:   PetscCall(BVDestroy(&d->auxBV));
     43:   PetscCall(MatDestroy(&d->H));
     44:   PetscCall(MatDestroy(&d->G));
     45:   PetscCall(MatDestroy(&d->auxM));
     46:   PetscCall(SlepcVecPoolDestroy(&d->auxV));
     47:   PetscCall(PetscFree(d->nBds));
     48:   PetscFunctionReturn(PETSC_SUCCESS);
     49: }

     51: /* in complex, d->size_H real auxiliary values are needed */
     52: static PetscErrorCode dvd_calcpairs_projeig_solve(dvdDashboard *d)
     53: {
     54:   Vec               v;
     55:   Mat               A,B,H0,G0;
     56:   PetscScalar       *pA;
     57:   const PetscScalar *pv;
     58:   PetscInt          i,lV,kV,n,ld;

     60:   PetscFunctionBegin;
     61:   PetscCall(BVGetActiveColumns(d->eps->V,&lV,&kV));
     62:   n = kV-lV;
     63:   if (!n) PetscFunctionReturn(PETSC_SUCCESS);
     64:   PetscCall(DSSetDimensions(d->eps->ds,n,0,0));
     65:   PetscCall(DSGetMat(d->eps->ds,DS_MAT_A,&A));
     66:   PetscCall(MatDenseGetSubMatrix(d->H,lV,lV+n,lV,lV+n,&H0));
     67:   PetscCall(MatCopy(H0,A,SAME_NONZERO_PATTERN));
     68:   PetscCall(MatDenseRestoreSubMatrix(d->H,&H0));
     69:   PetscCall(DSRestoreMat(d->eps->ds,DS_MAT_A,&A));
     70:   if (d->G) {
     71:     PetscCall(DSGetMat(d->eps->ds,DS_MAT_B,&B));
     72:     PetscCall(MatDenseGetSubMatrix(d->G,lV,lV+n,lV,lV+n,&G0));
     73:     PetscCall(MatCopy(G0,B,SAME_NONZERO_PATTERN));
     74:     PetscCall(MatDenseRestoreSubMatrix(d->G,&G0));
     75:     PetscCall(DSRestoreMat(d->eps->ds,DS_MAT_B,&B));
     76:   }
     77:   /* Set the signature on projected matrix B */
     78:   if (DVD_IS(d->sEP,DVD_EP_INDEFINITE)) {
     79:     PetscCall(DSGetLeadingDimension(d->eps->ds,&ld));
     80:     PetscCall(DSGetArray(d->eps->ds,DS_MAT_B,&pA));
     81:     PetscCall(PetscArrayzero(pA,n*ld));
     82:     PetscCall(VecCreateSeq(PETSC_COMM_SELF,kV,&v));
     83:     PetscCall(BVGetSignature(d->eps->V,v));
     84:     PetscCall(VecGetArrayRead(v,&pv));
     85:     for (i=0;i<n;i++) {
     86:       pA[i+ld*i] = d->nBds[i] = PetscRealPart(pv[lV+i]);
     87:     }
     88:     PetscCall(VecRestoreArrayRead(v,&pv));
     89:     PetscCall(VecDestroy(&v));
     90:     PetscCall(DSRestoreArray(d->eps->ds,DS_MAT_B,&pA));
     91:   }
     92:   PetscCall(DSSetState(d->eps->ds,DS_STATE_RAW));
     93:   PetscCall(DSSolve(d->eps->ds,d->eigr,d->eigi));
     94:   PetscFunctionReturn(PETSC_SUCCESS);
     95: }

     97: /*
     98:    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
     99:  */
    100: static PetscErrorCode EPSXDUpdateProj(Mat Q,Mat Z,PetscInt l,Mat A,PetscInt lA,PetscInt kA,Mat aux)
    101: {
    102:   PetscScalar       one=1.0,zero=0.0;
    103:   PetscInt          i,j,dA_=kA-lA,m0,n0,ldA_,ldQ_,ldZ_,nQ_;
    104:   PetscBLASInt      dA,nQ,ldA,ldQ,ldZ;
    105:   PetscScalar       *pA,*pW;
    106:   const PetscScalar *pQ,*pZ;
    107:   PetscBool         symm=PETSC_FALSE,set,flg;

    109:   PetscFunctionBegin;
    110:   PetscCall(MatGetSize(A,&m0,&n0));
    111:   PetscCall(MatDenseGetLDA(A,&ldA_));
    112:   PetscAssert(m0==n0,PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"A should be square");
    113:   PetscAssert(lA>=0 && lA<=m0,PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Invalid initial row, column in A");
    114:   PetscAssert(kA>=0 && kA>=lA && kA<=m0,PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Invalid final row, column in A");
    115:   PetscCall(MatIsHermitianKnown(A,&set,&flg));
    116:   symm = set? flg: PETSC_FALSE;
    117:   PetscCall(MatGetSize(Q,&m0,&n0)); nQ_=m0;
    118:   PetscCall(MatDenseGetLDA(Q,&ldQ_));
    119:   PetscAssert(l>=0 && l<=n0 && l+dA_<=n0,PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Invalid initial column in Q");
    120:   PetscCall(MatGetSize(Z,&m0,&n0));
    121:   PetscCall(MatDenseGetLDA(Z,&ldZ_));
    122:   PetscAssert(l>=0 && l<=n0 && l+dA_<=n0,PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Invalid initial column in Z");
    123:   PetscCall(MatGetSize(aux,&m0,&n0));
    124:   PetscAssert(m0*n0>=nQ_*dA_,PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"aux should be larger");
    125:   PetscCall(PetscBLASIntCast(dA_,&dA));
    126:   PetscCall(PetscBLASIntCast(nQ_,&nQ));
    127:   PetscCall(PetscBLASIntCast(ldA_,&ldA));
    128:   PetscCall(PetscBLASIntCast(ldQ_,&ldQ));
    129:   PetscCall(PetscBLASIntCast(ldZ_,&ldZ));
    130:   PetscCall(MatDenseGetArray(A,&pA));
    131:   PetscCall(MatDenseGetArrayRead(Q,&pQ));
    132:   if (Q!=Z) PetscCall(MatDenseGetArrayRead(Z,&pZ));
    133:   else pZ = pQ;
    134:   PetscCall(MatDenseGetArrayWrite(aux,&pW));
    135:   /* W = A*Q */
    136:   if (symm) {
    137:     /* symmetrize before multiplying */
    138:     for (i=lA+1;i<lA+nQ;i++) {
    139:       for (j=lA;j<i;j++) pA[i+j*ldA] = PetscConj(pA[j+i*ldA]);
    140:     }
    141:   }
    142:   PetscCallBLAS("BLASgemm",BLASgemm_("N","N",&nQ,&dA,&nQ,&one,&pA[ldA*lA+lA],&ldA,&pQ[ldQ*l+l],&ldQ,&zero,pW,&nQ));
    143:   /* A = Q'*W */
    144:   PetscCallBLAS("BLASgemm",BLASgemm_("C","N",&dA,&dA,&nQ,&one,&pZ[ldZ*l+l],&ldZ,pW,&nQ,&zero,&pA[ldA*lA+lA],&ldA));
    145:   PetscCall(MatDenseRestoreArray(A,&pA));
    146:   PetscCall(MatDenseRestoreArrayRead(Q,&pQ));
    147:   if (Q!=Z) PetscCall(MatDenseRestoreArrayRead(Z,&pZ));
    148:   PetscCall(MatDenseRestoreArrayWrite(aux,&pW));
    149:   PetscFunctionReturn(PETSC_SUCCESS);
    150: }

    152: static PetscErrorCode dvd_calcpairs_updateproj(dvdDashboard *d)
    153: {
    154:   Mat            Q,Z;
    155:   PetscInt       lV,kV;
    156:   PetscBool      symm;

    158:   PetscFunctionBegin;
    159:   PetscCall(DSGetMat(d->eps->ds,DS_MAT_Q,&Q));
    160:   if (d->W) PetscCall(DSGetMat(d->eps->ds,DS_MAT_Z,&Z));
    161:   else Z = Q;
    162:   PetscCall(BVGetActiveColumns(d->eps->V,&lV,&kV));
    163:   PetscCall(EPSXDUpdateProj(Q,Z,0,d->H,lV,lV+d->V_tra_e,d->auxM));
    164:   if (d->G) PetscCall(EPSXDUpdateProj(Q,Z,0,d->G,lV,lV+d->V_tra_e,d->auxM));
    165:   PetscCall(DSRestoreMat(d->eps->ds,DS_MAT_Q,&Q));
    166:   if (d->W) PetscCall(DSRestoreMat(d->eps->ds,DS_MAT_Z,&Z));

    168:   PetscCall(PetscObjectTypeCompareAny((PetscObject)d->eps->ds,&symm,DSHEP,DSGHIEP,DSGHEP,""));
    169:   if (d->V_tra_s==0 || symm) PetscFunctionReturn(PETSC_SUCCESS);
    170:   /* Compute upper part of H (and G): H(0:l-1,l:k-1) <- W(0:l-1)' * AV(l:k-1), where
    171:      k=l+d->V_tra_s */
    172:   PetscCall(BVSetActiveColumns(d->W?d->W:d->eps->V,0,lV));
    173:   PetscCall(BVSetActiveColumns(d->AX,lV,lV+d->V_tra_s));
    174:   PetscCall(BVDot(d->AX,d->W?d->W:d->eps->V,d->H));
    175:   if (d->G) {
    176:     PetscCall(BVSetActiveColumns(d->BX?d->BX:d->eps->V,lV,lV+d->V_tra_s));
    177:     PetscCall(BVDot(d->BX?d->BX:d->eps->V,d->W?d->W:d->eps->V,d->G));
    178:   }
    179:   PetscCall(PetscObjectTypeCompare((PetscObject)d->eps->ds,DSGHEP,&symm));
    180:   if (!symm) {
    181:     PetscCall(BVSetActiveColumns(d->W?d->W:d->eps->V,lV,lV+d->V_tra_s));
    182:     PetscCall(BVSetActiveColumns(d->AX,0,lV));
    183:     PetscCall(BVDot(d->AX,d->W?d->W:d->eps->V,d->H));
    184:     if (d->G) {
    185:       PetscCall(BVSetActiveColumns(d->BX?d->BX:d->eps->V,0,lV));
    186:       PetscCall(BVDot(d->BX?d->BX:d->eps->V,d->W?d->W:d->eps->V,d->G));
    187:     }
    188:   }
    189:   PetscCall(BVSetActiveColumns(d->eps->V,lV,kV));
    190:   PetscCall(BVSetActiveColumns(d->AX,lV,kV));
    191:   if (d->BX) PetscCall(BVSetActiveColumns(d->BX,lV,kV));
    192:   if (d->W) PetscCall(BVSetActiveColumns(d->W,lV,kV));
    193:   if (d->W) PetscCall(dvd_harm_updateproj(d));
    194:   PetscFunctionReturn(PETSC_SUCCESS);
    195: }

    197: /*
    198:    BV <- BV*MT
    199:  */
    200: static inline PetscErrorCode dvd_calcpairs_updateBV0_gen(dvdDashboard *d,BV bv,DSMatType mat)
    201: {
    202:   PetscInt       l,k,n;
    203:   Mat            M,M0,auxM,auxM0;

    205:   PetscFunctionBegin;
    206:   PetscCall(BVGetActiveColumns(d->eps->V,&l,&k));
    207:   PetscCall(DSGetDimensions(d->eps->ds,&n,NULL,NULL,NULL));
    208:   PetscAssert(k-l==n,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Consistency broken");
    209:   PetscCall(DSGetMat(d->eps->ds,mat,&M));
    210:   PetscCall(MatDenseGetSubMatrix(M,0,n,0,d->V_tra_e,&M0));
    211:   PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,k,k,NULL,&auxM));
    212:   PetscCall(MatDenseGetSubMatrix(auxM,l,l+n,l,l+d->V_tra_e,&auxM0));
    213:   PetscCall(MatCopy(M0,auxM0,SAME_NONZERO_PATTERN));
    214:   PetscCall(MatDenseRestoreSubMatrix(auxM,&auxM0));
    215:   PetscCall(MatDenseRestoreSubMatrix(M,&M0));
    216:   PetscCall(DSRestoreMat(d->eps->ds,mat,&M));
    217:   PetscCall(BVMultInPlace(bv,auxM,l,l+d->V_tra_e));
    218:   PetscCall(MatDestroy(&auxM));
    219:   PetscFunctionReturn(PETSC_SUCCESS);
    220: }

    222: static PetscErrorCode dvd_calcpairs_proj(dvdDashboard *d)
    223: {
    224:   PetscInt       i,l,k;
    225:   Vec            v1,v2;
    226:   PetscScalar    *pv;

    228:   PetscFunctionBegin;
    229:   PetscCall(BVGetActiveColumns(d->eps->V,&l,&k));
    230:   /* Update AV, BV, W and the projected matrices */
    231:   /* 1. S <- S*MT */
    232:   if (d->V_tra_s != d->V_tra_e || d->V_tra_e > 0) {
    233:     PetscCall(dvd_calcpairs_updateBV0_gen(d,d->eps->V,DS_MAT_Q));
    234:     if (d->W) PetscCall(dvd_calcpairs_updateBV0_gen(d,d->W,DS_MAT_Z));
    235:     PetscCall(dvd_calcpairs_updateBV0_gen(d,d->AX,DS_MAT_Q));
    236:     if (d->BX) PetscCall(dvd_calcpairs_updateBV0_gen(d,d->BX,DS_MAT_Q));
    237:     PetscCall(dvd_calcpairs_updateproj(d));
    238:     /* Update signature */
    239:     if (d->nBds) {
    240:       PetscCall(VecCreateSeq(PETSC_COMM_SELF,l+d->V_tra_e,&v1));
    241:       PetscCall(BVSetActiveColumns(d->eps->V,0,l+d->V_tra_e));
    242:       PetscCall(BVGetSignature(d->eps->V,v1));
    243:       PetscCall(VecGetArray(v1,&pv));
    244:       for (i=0;i<d->V_tra_e;i++) pv[l+i] = d->nBds[i];
    245:       PetscCall(VecRestoreArray(v1,&pv));
    246:       PetscCall(BVSetSignature(d->eps->V,v1));
    247:       PetscCall(BVSetActiveColumns(d->eps->V,l,k));
    248:       PetscCall(VecDestroy(&v1));
    249:     }
    250:     k = l+d->V_tra_e;
    251:     l+= d->V_tra_s;
    252:   } else {
    253:     /* 2. V <- orth(V, V_new) */
    254:     PetscCall(dvd_orthV(d->eps->V,l+d->V_new_s,l+d->V_new_e));
    255:     /* 3. AV <- [AV A * V(V_new_s:V_new_e-1)] */
    256:     /* Check consistency */
    257:     PetscAssert(k-l==d->V_new_s,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Consistency broken");
    258:     for (i=l+d->V_new_s;i<l+d->V_new_e;i++) {
    259:       PetscCall(BVGetColumn(d->eps->V,i,&v1));
    260:       PetscCall(BVGetColumn(d->AX,i,&v2));
    261:       PetscCall(MatMult(d->A,v1,v2));
    262:       PetscCall(BVRestoreColumn(d->eps->V,i,&v1));
    263:       PetscCall(BVRestoreColumn(d->AX,i,&v2));
    264:     }
    265:     /* 4. BV <- [BV B * V(V_new_s:V_new_e-1)] */
    266:     if (d->BX) {
    267:       /* Check consistency */
    268:       PetscAssert(k-l==d->V_new_s,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Consistency broken");
    269:       for (i=l+d->V_new_s;i<l+d->V_new_e;i++) {
    270:         PetscCall(BVGetColumn(d->eps->V,i,&v1));
    271:         PetscCall(BVGetColumn(d->BX,i,&v2));
    272:         PetscCall(MatMult(d->B,v1,v2));
    273:         PetscCall(BVRestoreColumn(d->eps->V,i,&v1));
    274:         PetscCall(BVRestoreColumn(d->BX,i,&v2));
    275:       }
    276:     }
    277:     /* 5. W <- [W f(AV,BV)] */
    278:     if (d->W) {
    279:       PetscCall(d->calcpairs_W(d));
    280:       PetscCall(dvd_orthV(d->W,l+d->V_new_s,l+d->V_new_e));
    281:     }
    282:     /* 6. H <- W' * AX; G <- W' * BX */
    283:     PetscCall(BVSetActiveColumns(d->eps->V,l+d->V_new_s,l+d->V_new_e));
    284:     PetscCall(BVSetActiveColumns(d->AX,l+d->V_new_s,l+d->V_new_e));
    285:     if (d->BX) PetscCall(BVSetActiveColumns(d->BX,l+d->V_new_s,l+d->V_new_e));
    286:     if (d->W) PetscCall(BVSetActiveColumns(d->W,l+d->V_new_s,l+d->V_new_e));
    287:     PetscCall(BVMatProject(d->AX,NULL,d->W?d->W:d->eps->V,d->H));
    288:     if (d->G) PetscCall(BVMatProject(d->BX?d->BX:d->eps->V,NULL,d->W?d->W:d->eps->V,d->G));
    289:     PetscCall(BVSetActiveColumns(d->eps->V,l,k));
    290:     PetscCall(BVSetActiveColumns(d->AX,l,k));
    291:     if (d->BX) PetscCall(BVSetActiveColumns(d->BX,l,k));
    292:     if (d->W) PetscCall(BVSetActiveColumns(d->W,l,k));

    294:     /* Perform the transformation on the projected problem */
    295:     if (d->W) PetscCall(d->calcpairs_proj_trans(d));
    296:     k = l+d->V_new_e;
    297:   }
    298:   PetscCall(BVSetActiveColumns(d->eps->V,l,k));
    299:   PetscCall(BVSetActiveColumns(d->AX,l,k));
    300:   if (d->BX) PetscCall(BVSetActiveColumns(d->BX,l,k));
    301:   if (d->W) PetscCall(BVSetActiveColumns(d->W,l,k));

    303:   /* Solve the projected problem */
    304:   PetscCall(dvd_calcpairs_projeig_solve(d));

    306:   d->V_tra_s = d->V_tra_e = 0;
    307:   d->V_new_s = d->V_new_e;
    308:   PetscFunctionReturn(PETSC_SUCCESS);
    309: }

    311: static PetscErrorCode dvd_calcpairs_apply_arbitrary(dvdDashboard *d,PetscInt r_s,PetscInt r_e,PetscScalar *rr,PetscScalar *ri)
    312: {
    313:   PetscInt       i,k,ld;
    314:   PetscScalar    *pX;
    315:   Vec            *X,xr,xi;
    316: #if defined(PETSC_USE_COMPLEX)
    317:   PetscInt       N=1;
    318: #else
    319:   PetscInt       N=2,j;
    320: #endif

    322:   PetscFunctionBegin;
    323:   /* Quick exit without neither arbitrary selection nor harmonic extraction */
    324:   if (!d->eps->arbitrary && !d->calcpairs_eig_backtrans) PetscFunctionReturn(PETSC_SUCCESS);

    326:   /* Quick exit without arbitrary selection, but with harmonic extraction */
    327:   if (d->calcpairs_eig_backtrans) {
    328:     for (i=r_s; i<r_e; i++) PetscCall(d->calcpairs_eig_backtrans(d,d->eigr[i],d->eigi[i],&rr[i-r_s],&ri[i-r_s]));
    329:   }
    330:   if (!d->eps->arbitrary) PetscFunctionReturn(PETSC_SUCCESS);

    332:   PetscCall(SlepcVecPoolGetVecs(d->auxV,N,&X));
    333:   PetscCall(DSGetLeadingDimension(d->eps->ds,&ld));
    334:   for (i=r_s;i<r_e;i++) {
    335:     k = i;
    336:     PetscCall(DSVectors(d->eps->ds,DS_MAT_X,&k,NULL));
    337:     PetscCall(DSGetArray(d->eps->ds,DS_MAT_X,&pX));
    338:     PetscCall(dvd_improvex_compute_X(d,i,k+1,X,pX,ld));
    339:     PetscCall(DSRestoreArray(d->eps->ds,DS_MAT_X,&pX));
    340: #if !defined(PETSC_USE_COMPLEX)
    341:     if (d->nX[i] != 1.0) {
    342:       for (j=i;j<k+1;j++) PetscCall(VecScale(X[j-i],1.0/d->nX[i]));
    343:     }
    344:     xr = X[0];
    345:     xi = X[1];
    346:     if (i == k) PetscCall(VecSet(xi,0.0));
    347: #else
    348:     xr = X[0];
    349:     xi = NULL;
    350:     if (d->nX[i] != 1.0) PetscCall(VecScale(xr,1.0/d->nX[i]));
    351: #endif
    352:     PetscCall(d->eps->arbitrary(rr[i-r_s],ri[i-r_s],xr,xi,&rr[i-r_s],&ri[i-r_s],d->eps->arbitraryctx));
    353: #if !defined(PETSC_USE_COMPLEX)
    354:     if (i != k) {
    355:       rr[i+1-r_s] = rr[i-r_s];
    356:       ri[i+1-r_s] = ri[i-r_s];
    357:       i++;
    358:     }
    359: #endif
    360:   }
    361:   PetscCall(SlepcVecPoolRestoreVecs(d->auxV,N,&X));
    362:   PetscFunctionReturn(PETSC_SUCCESS);
    363: }

    365: static PetscErrorCode dvd_calcpairs_selectPairs(dvdDashboard *d,PetscInt n)
    366: {
    367:   PetscInt       k,lV,kV,nV;
    368:   PetscScalar    *rr,*ri;

    370:   PetscFunctionBegin;
    371:   PetscCall(BVGetActiveColumns(d->eps->V,&lV,&kV));
    372:   nV = kV - lV;
    373:   n = PetscMin(n,nV);
    374:   if (n <= 0) PetscFunctionReturn(PETSC_SUCCESS);
    375:   /* Put the best n pairs at the beginning. Useful for restarting */
    376:   if (d->eps->arbitrary || d->calcpairs_eig_backtrans) {
    377:     PetscCall(PetscMalloc1(nV,&rr));
    378:     PetscCall(PetscMalloc1(nV,&ri));
    379:     PetscCall(dvd_calcpairs_apply_arbitrary(d,0,nV,rr,ri));
    380:   } else {
    381:     rr = d->eigr;
    382:     ri = d->eigi;
    383:   }
    384:   k = n;
    385:   PetscCall(DSSort(d->eps->ds,d->eigr,d->eigi,rr,ri,&k));
    386:   /* Put the best pair at the beginning. Useful to check its residual */
    387: #if !defined(PETSC_USE_COMPLEX)
    388:   if (n != 1 && (n != 2 || d->eigi[0] == 0.0))
    389: #else
    390:   if (n != 1)
    391: #endif
    392:   {
    393:     PetscCall(dvd_calcpairs_apply_arbitrary(d,0,nV,rr,ri));
    394:     k = 1;
    395:     PetscCall(DSSort(d->eps->ds,d->eigr,d->eigi,rr,ri,&k));
    396:   }
    397:   PetscCall(DSSynchronize(d->eps->ds,d->eigr,d->eigi));

    399:   if (d->calcpairs_eigs_trans) PetscCall(d->calcpairs_eigs_trans(d));
    400:   if (d->eps->arbitrary || d->calcpairs_eig_backtrans) {
    401:     PetscCall(PetscFree(rr));
    402:     PetscCall(PetscFree(ri));
    403:   }
    404:   PetscFunctionReturn(PETSC_SUCCESS);
    405: }

    407: static PetscErrorCode EPSXDComputeDSConv(dvdDashboard *d)
    408: {
    409:   PetscInt          i,ld;
    410:   Vec               v;
    411:   Mat               A,B,H0,G0;
    412:   PetscScalar       *pA;
    413:   const PetscScalar *pv;
    414:   PetscBool         symm;

    416:   PetscFunctionBegin;
    417:   PetscCall(BVSetActiveColumns(d->eps->V,0,d->eps->nconv));
    418:   PetscCall(PetscObjectTypeCompare((PetscObject)d->eps->ds,DSHEP,&symm));
    419:   if (symm || !d->eps->nconv) PetscFunctionReturn(PETSC_SUCCESS);
    420:   PetscCall(DSSetDimensions(d->eps->ds,d->eps->nconv,0,0));
    421:   PetscCall(DSGetMat(d->eps->ds,DS_MAT_A,&A));
    422:   PetscCall(MatDenseGetSubMatrix(d->H,0,d->eps->nconv,0,d->eps->nconv,&H0));
    423:   PetscCall(MatCopy(H0,A,SAME_NONZERO_PATTERN));
    424:   PetscCall(MatDenseRestoreSubMatrix(d->H,&H0));
    425:   PetscCall(DSRestoreMat(d->eps->ds,DS_MAT_A,&A));
    426:   if (d->G) {
    427:     PetscCall(DSGetMat(d->eps->ds,DS_MAT_B,&B));
    428:     PetscCall(MatDenseGetSubMatrix(d->G,0,d->eps->nconv,0,d->eps->nconv,&G0));
    429:     PetscCall(MatCopy(G0,B,SAME_NONZERO_PATTERN));
    430:     PetscCall(MatDenseRestoreSubMatrix(d->G,&G0));
    431:     PetscCall(DSRestoreMat(d->eps->ds,DS_MAT_B,&B));
    432:   }
    433:   /* Set the signature on projected matrix B */
    434:   if (DVD_IS(d->sEP,DVD_EP_INDEFINITE)) {
    435:     PetscCall(DSGetLeadingDimension(d->eps->ds,&ld));
    436:     PetscCall(DSGetArray(d->eps->ds,DS_MAT_B,&pA));
    437:     PetscCall(PetscArrayzero(pA,d->eps->nconv*ld));
    438:     PetscCall(VecCreateSeq(PETSC_COMM_SELF,d->eps->nconv,&v));
    439:     PetscCall(BVGetSignature(d->eps->V,v));
    440:     PetscCall(VecGetArrayRead(v,&pv));
    441:     for (i=0;i<d->eps->nconv;i++) pA[i+ld*i] = pv[i];
    442:     PetscCall(VecRestoreArrayRead(v,&pv));
    443:     PetscCall(VecDestroy(&v));
    444:     PetscCall(DSRestoreArray(d->eps->ds,DS_MAT_B,&pA));
    445:   }
    446:   PetscCall(DSSetState(d->eps->ds,DS_STATE_RAW));
    447:   PetscCall(DSSolve(d->eps->ds,d->eps->eigr,d->eps->eigi));
    448:   PetscCall(DSSynchronize(d->eps->ds,d->eps->eigr,d->eps->eigi));
    449:   if (d->W) {
    450:     for (i=0;i<d->eps->nconv;i++) PetscCall(d->calcpairs_eig_backtrans(d,d->eps->eigr[i],d->eps->eigi[i],&d->eps->eigr[i],&d->eps->eigi[i]));
    451:   }
    452:   PetscFunctionReturn(PETSC_SUCCESS);
    453: }

    455: /*
    456:    Compute the residual vectors R(i) <- (AV - BV*eigr(i))*pX(i), and also
    457:    the norm associated to the Schur pair, where i = r_s..r_e
    458: */
    459: static PetscErrorCode dvd_calcpairs_res_0(dvdDashboard *d,PetscInt r_s,PetscInt r_e)
    460: {
    461:   PetscInt       i,ldpX;
    462:   PetscScalar    *pX;
    463:   BV             BX = d->BX?d->BX:d->eps->V;
    464:   Vec            *R;

    466:   PetscFunctionBegin;
    467:   PetscCall(DSGetLeadingDimension(d->eps->ds,&ldpX));
    468:   PetscCall(DSGetArray(d->eps->ds,DS_MAT_Q,&pX));
    469:   /* nX(i) <- ||X(i)|| */
    470:   PetscCall(dvd_improvex_compute_X(d,r_s,r_e,NULL,pX,ldpX));
    471:   PetscCall(SlepcVecPoolGetVecs(d->auxV,r_e-r_s,&R));
    472:   for (i=r_s;i<r_e;i++) {
    473:     /* R(i-r_s) <- AV*pX(i) */
    474:     PetscCall(BVMultVec(d->AX,1.0,0.0,R[i-r_s],&pX[ldpX*i]));
    475:     /* R(i-r_s) <- R(i-r_s) - eigr(i)*BX*pX(i) */
    476:     PetscCall(BVMultVec(BX,-d->eigr[i],1.0,R[i-r_s],&pX[ldpX*i]));
    477:   }
    478:   PetscCall(DSRestoreArray(d->eps->ds,DS_MAT_Q,&pX));
    479:   PetscCall(d->calcpairs_proj_res(d,r_s,r_e,R));
    480:   PetscCall(SlepcVecPoolRestoreVecs(d->auxV,r_e-r_s,&R));
    481:   PetscFunctionReturn(PETSC_SUCCESS);
    482: }

    484: static PetscErrorCode dvd_calcpairs_proj_res(dvdDashboard *d,PetscInt r_s,PetscInt r_e,Vec *R)
    485: {
    486:   PetscInt       i,l,k;
    487:   PetscBool      lindep=PETSC_FALSE;
    488:   BV             cX;

    490:   PetscFunctionBegin;
    491:   if (d->W) cX = d->W; /* If left subspace exists, R <- orth(cY, R), nR[i] <- ||R[i]|| */
    492:   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]|| */
    493:   else cX = NULL; /* Otherwise, nR[i] <- ||R[i]|| */

    495:   if (cX) {
    496:     PetscCall(BVGetActiveColumns(cX,&l,&k));
    497:     PetscCall(BVSetActiveColumns(cX,0,l));
    498:     for (i=0;i<r_e-r_s;i++) PetscCall(BVOrthogonalizeVec(cX,R[i],NULL,&d->nR[r_s+i],&lindep));
    499:     PetscCall(BVSetActiveColumns(cX,l,k));
    500:     if (lindep || (PetscAbs(d->nR[r_s+i]) < PETSC_MACHINE_EPSILON)) PetscCall(PetscInfo(d->eps,"The computed eigenvector residual %" PetscInt_FMT " is too low, %g!\n",r_s+i,(double)d->nR[r_s+i]));
    501:   } else {
    502:     for (i=0;i<r_e-r_s;i++) PetscCall(VecNormBegin(R[i],NORM_2,&d->nR[r_s+i]));
    503:     for (i=0;i<r_e-r_s;i++) PetscCall(VecNormEnd(R[i],NORM_2,&d->nR[r_s+i]));
    504:   }
    505:   PetscFunctionReturn(PETSC_SUCCESS);
    506: }

    508: PetscErrorCode dvd_calcpairs_qz(dvdDashboard *d,dvdBlackboard *b,PetscBool borth,PetscBool harm)
    509: {
    510:   PetscBool      std_probl,her_probl,ind_probl;
    511:   DSType         dstype;
    512:   Vec            v1;

    514:   PetscFunctionBegin;
    515:   std_probl = DVD_IS(d->sEP,DVD_EP_STD)? PETSC_TRUE: PETSC_FALSE;
    516:   her_probl = DVD_IS(d->sEP,DVD_EP_HERMITIAN)? PETSC_TRUE: PETSC_FALSE;
    517:   ind_probl = DVD_IS(d->sEP,DVD_EP_INDEFINITE)? PETSC_TRUE: PETSC_FALSE;

    519:   /* Setting configuration constrains */
    520:   b->max_size_proj = PetscMax(b->max_size_proj,b->max_size_V);
    521:   d->W_shift = d->B? PETSC_TRUE: PETSC_FALSE;

    523:   /* Setup the step */
    524:   if (b->state >= DVD_STATE_CONF) {
    525:     d->max_size_P = b->max_size_P;
    526:     d->max_size_proj = b->max_size_proj;
    527:     /* Create a DS if the method works with Schur decompositions */
    528:     d->calcPairs = dvd_calcpairs_proj;
    529:     d->calcpairs_residual = dvd_calcpairs_res_0;
    530:     d->calcpairs_proj_res = dvd_calcpairs_proj_res;
    531:     d->calcpairs_selectPairs = dvd_calcpairs_selectPairs;
    532:     /* Create and configure a DS for solving the projected problems */
    533:     if (d->W) dstype = DSGNHEP;    /* If we use harmonics */
    534:     else {
    535:       if (ind_probl) dstype = DSGHIEP;
    536:       else if (std_probl) dstype = her_probl? DSHEP : DSNHEP;
    537:       else dstype = her_probl? DSGHEP : DSGNHEP;
    538:     }
    539:     PetscCall(DSSetType(d->eps->ds,dstype));
    540:     PetscCall(DSAllocate(d->eps->ds,d->eps->ncv));
    541:     /* Create various vector basis */
    542:     if (harm) {
    543:       PetscCall(BVDuplicateResize(d->eps->V,d->eps->ncv,&d->W));
    544:       PetscCall(BVSetMatrix(d->W,NULL,PETSC_FALSE));
    545:     } else d->W = NULL;
    546:     PetscCall(BVDuplicateResize(d->eps->V,d->eps->ncv,&d->AX));
    547:     PetscCall(BVSetMatrix(d->AX,NULL,PETSC_FALSE));
    548:     PetscCall(BVDuplicateResize(d->eps->V,d->eps->ncv,&d->auxBV));
    549:     PetscCall(BVSetMatrix(d->auxBV,NULL,PETSC_FALSE));
    550:     if (d->B) {
    551:       PetscCall(BVDuplicateResize(d->eps->V,d->eps->ncv,&d->BX));
    552:       PetscCall(BVSetMatrix(d->BX,NULL,PETSC_FALSE));
    553:     } else d->BX = NULL;
    554:     PetscCall(MatCreateVecsEmpty(d->A,&v1,NULL));
    555:     PetscCall(SlepcVecPoolCreate(v1,0,&d->auxV));
    556:     PetscCall(VecDestroy(&v1));
    557:     /* Create projected problem matrices */
    558:     PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,d->eps->ncv,d->eps->ncv,NULL,&d->H));
    559:     if (!std_probl) PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,d->eps->ncv,d->eps->ncv,NULL,&d->G));
    560:     else d->G = NULL;
    561:     if (her_probl) {
    562:       PetscCall(MatSetOption(d->H,MAT_HERMITIAN,PETSC_TRUE));
    563:       if (d->G) PetscCall(MatSetOption(d->G,MAT_HERMITIAN,PETSC_TRUE));
    564:     }

    566:     if (ind_probl) PetscCall(PetscMalloc1(d->eps->ncv,&d->nBds));
    567:     else d->nBds = NULL;
    568:     PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,d->eps->ncv,d->eps->ncv,NULL,&d->auxM));

    570:     PetscCall(EPSDavidsonFLAdd(&d->startList,dvd_calcpairs_qz_start));
    571:     PetscCall(EPSDavidsonFLAdd(&d->endList,EPSXDComputeDSConv));
    572:     PetscCall(EPSDavidsonFLAdd(&d->destroyList,dvd_calcpairs_qz_d));
    573:   }
    574:   PetscFunctionReturn(PETSC_SUCCESS);
    575: }