Date: 2017-05-17T08:27:02+00:00

Actual source code: pjd.c
slepc-3.7.4 2017-05-17
Report Typos and Errors

      1: /*

      3:    SLEPc polynomial eigensolver: "jd"

      5:    Method: Jacobi-Davidson

      7:    Algorithm:

      9:        Jacobi-Davidson for polynomial eigenvalue problems.
     10:        Based on code contributed by the authors of [2] below.

     12:    References:

     14:        [1] G.L.G. Sleijpen et al., "Jacobi-Davidson type methods for
     15:            generalized eigenproblems and polynomial eigenproblems", BIT
     16:            36(3):595-633, 1996.

     18:        [2] Feng-Nan Hwang, Zih-Hao Wei, Tsung-Ming Huang, Weichung Wang,
     19:            "A Parallel Additive Schwarz Preconditioned Jacobi-Davidson
     20:            Algorithm for Polynomial Eigenvalue Problems in Quantum Dot
     21:            Simulation", J. Comput. Phys. 229(8):2932-2947, 2010.

     23:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     24:    SLEPc - Scalable Library for Eigenvalue Problem Computations
     25:    Copyright (c) 2002-2016, Universitat Politecnica de Valencia, Spain

     27:    This file is part of SLEPc.

     29:    SLEPc is free software: you can redistribute it and/or modify it under  the
     30:    terms of version 3 of the GNU Lesser General Public License as published by
     31:    the Free Software Foundation.

     33:    SLEPc  is  distributed in the hope that it will be useful, but WITHOUT  ANY
     34:    WARRANTY;  without even the implied warranty of MERCHANTABILITY or  FITNESS
     35:    FOR  A  PARTICULAR PURPOSE. See the GNU Lesser General Public  License  for
     36:    more details.

     38:    You  should have received a copy of the GNU Lesser General  Public  License
     39:    along with SLEPc. If not, see <http://www.gnu.org/licenses/>.
     40:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     41: */

     43: #include <slepc/private/pepimpl.h>    /*I "slepcpep.h" I*/
     44:  #include pjdp.h
     45: #include <slepcblaslapack.h>

     49: /*
     50:    Duplicate and resize auxiliary basis
     51: */
     52: static PetscErrorCode PEPJDDuplicateBasis(PEP pep,BV *basis)
     53: {
     54:   PetscErrorCode     ierr;
     55:   PetscInt           nloc,m;
     56:   PetscMPIInt        rank,nproc;
     57:   BVType             type;
     58:   BVOrthogType       otype;
     59:   BVOrthogRefineType oref;
     60:   PetscReal          oeta;
     61:   BVOrthogBlockType  oblock;

     64:   if (pep->nev>1) {
     65:     BVCreate(PetscObjectComm((PetscObject)pep),basis);
     66:     MPI_Comm_rank(PetscObjectComm((PetscObject)pep),&rank);
     67:     MPI_Comm_size(PetscObjectComm((PetscObject)pep),&nproc);
     68:     BVGetSizes(pep->V,&nloc,NULL,&m);
     69:     if (rank==nproc-1) nloc += pep->nev-1;
     70:     BVSetSizes(*basis,nloc,PETSC_DECIDE,m);
     71:     BVGetType(pep->V,&type);
     72:     BVSetType(*basis,type);
     73:     BVGetOrthogonalization(pep->V,&otype,&oref,&oeta,&oblock);
     74:     BVSetOrthogonalization(*basis,otype,oref,oeta,oblock);
     75:     PetscObjectStateIncrease((PetscObject)*basis);
     76:   } else {
     77:     BVDuplicate(pep->V,basis);
     78:   }
     79:   return(0);
     80: }

     84: PetscErrorCode PEPSetUp_JD(PEP pep)
     85: {
     87:   PEP_JD         *pjd = (PEP_JD*)pep->data;
     88:   PetscBool      isprecond,flg;
     89:   PetscInt       i;
     90:   KSP            ksp;

     93:   pep->lineariz = PETSC_FALSE;
     94:   PEPSetDimensions_Default(pep,pep->nev,&pep->ncv,&pep->mpd);
     95:   if (!pep->max_it) pep->max_it = PetscMax(100,2*pep->n/pep->ncv);
     96:   if (!pep->which) pep->which = PEP_TARGET_MAGNITUDE;
     97:   if (pep->which != PEP_TARGET_MAGNITUDE) SETERRQ(PetscObjectComm((PetscObject)pep),PETSC_ERR_SUP,"PEPJD only supports which=target_magnitude");;

     99:   /* Set STPRECOND as the default ST */
    100:   if (!((PetscObject)pep->st)->type_name) {
    101:     STSetType(pep->st,STPRECOND);
    102:   }
    103:   PetscObjectTypeCompare((PetscObject)pep->st,STPRECOND,&isprecond);
    104:   if (!isprecond) SETERRQ(PetscObjectComm((PetscObject)pep),PETSC_ERR_SUP,"JD only works with PRECOND spectral transformation");

    106:   if (pep->basis!=PEP_BASIS_MONOMIAL) SETERRQ(PetscObjectComm((PetscObject)pep),PETSC_ERR_SUP,"Solver not implemented for non-monomial bases");
    107:   STGetTransform(pep->st,&flg);
    108:   if (flg) SETERRQ(PetscObjectComm((PetscObject)pep),PETSC_ERR_SUP,"Solver requires the ST transformation flag unset, see STSetTransform()");

    110:   /* Set the default options of the KSP */
    111:   STGetKSP(pep->st,&ksp);
    112:   if (!((PetscObject)ksp)->type_name) {
    113:     KSPSetType(ksp,KSPBCGSL);
    114:     KSPSetTolerances(ksp,1e-5,PETSC_DEFAULT,PETSC_DEFAULT,100);
    115:   }

    117:   if (!pjd->keep) pjd->keep = 0.5;

    119:   PEPAllocateSolution(pep,0);
    120:   PEPSetWorkVecs(pep,5);
    121:   PetscMalloc2(pep->nmat,&pjd->TV,pep->nmat,&pjd->AX);
    122:   for (i=0;i<pep->nmat;i++) {
    123:     PEPJDDuplicateBasis(pep,pjd->TV+i);
    124:   }
    125:   PEPJDDuplicateBasis(pep,&pjd->W);
    126:   if (pep->nev>1) {
    127:     PEPJDDuplicateBasis(pep,&pjd->V);
    128:     BVSetFromOptions(pjd->V);
    129:     for (i=0;i<pep->nmat;i++) {
    130:       BVDuplicateResize(pep->V,pep->nev-1,pjd->AX+i);
    131:     }
    132:     BVDuplicateResize(pep->V,pep->nev,&pjd->X);
    133:     PetscCalloc3((pep->nev)*(pep->nev),&pjd->XpX,pep->nev*pep->nev,&pjd->T,pep->nev*pep->nev*pep->nmat,&pjd->Tj);
    134:   } else pjd->V = pep->V;
    135:   DSSetType(pep->ds,DSPEP);
    136:   DSPEPSetDegree(pep->ds,pep->nmat-1);
    137:   DSAllocate(pep->ds,pep->ncv);
    138:   return(0);
    139: }

    143: /*
    144:    Updates columns (low to (high-1)) of TV[i]
    145: */
    146: static PetscErrorCode PEPJDUpdateTV(PEP pep,PetscInt low,PetscInt high,Vec *w)
    147: {
    149:   PEP_JD         *pjd = (PEP_JD*)pep->data;
    150:   PetscInt       pp,col,i,j,nloc,nconv,deg=pep->nmat-1;
    151:   Vec            v1,v2,t1,t2;
    152:   PetscScalar    *array1,*array2,*x2,*tt,*xx,*y2,zero=0.0,sone=1.0;
    153:   PetscMPIInt    rk,np,count;
    154:   PetscBLASInt   n,ld,one=1;

    157:   nconv = pjd->nconv;
    158:   PetscMalloc3(nconv,&tt,nconv,&x2,nconv,&xx);
    159:   MPI_Comm_rank(PetscObjectComm((PetscObject)pep),&rk);
    160:   MPI_Comm_size(PetscObjectComm((PetscObject)pep),&np);
    161:   BVGetSizes(pep->V,&nloc,NULL,NULL);
    162:   t1 = w[0];
    163:   t2 = w[1];
    164:   for (col=low;col<high;col++) {
    165:     BVGetColumn(pjd->V,col,&v1);
    166:     VecGetArray(v1,&array1);
    167:     if (nconv>0) {
    168:       if (rk==np-1) { for (i=0;i<nconv;i++) x2[i] = array1[nloc+i]; }
    169:       PetscMPIIntCast(nconv,&count);
    170:       MPI_Bcast(x2,nconv,MPIU_SCALAR,np-1,PetscObjectComm((PetscObject)pep));
    171:     }
    172:     VecPlaceArray(t1,array1);
    173:     for (pp=0;pp<pep->nmat;pp++) {
    174:       BVGetColumn(pjd->TV[pp],col,&v2);
    175:       VecGetArray(v2,&array2);
    176:       VecPlaceArray(t2,array2);
    177:       MatMult(pep->A[pp],t1,t2);
    178:       if (nconv) {
    179:         PetscBLASIntCast(pjd->nconv,&n);
    180:         PetscBLASIntCast(pep->nev,&ld);
    181:         for (j=0;j<nconv;j++) tt[j] = x2[j];
    182:         for (i=pp+1;i<pep->nmat;i++) {
    183:           BVMultVec(pjd->AX[i],1.0,1.0,t2,tt);
    184:           if (i!=pep->nmat-1) PetscStackCallBLAS("BLAStrmv",BLAStrmv_("U","N","N",&n,pjd->T,&ld,tt,&one));
    185:         }
    186:         BVDotVec(pjd->X,t1,xx);
    187:         if (rk==np-1 && pp<deg) {
    188:           y2 = array2+nloc;
    189:           for (j=0;j<nconv;j++) { y2[j] = xx[j]; xx[j] = x2[j]; }
    190:           PetscStackCallBLAS("BLAStrmv",BLAStrmv_("U","C","N",&n,pjd->Tj+ld*ld*pp,&ld,y2,&one));
    191:           for (i=pp+1;i<pep->nmat-1;i++) {
    192:             PetscStackCallBLAS("BLASgemv",BLASgemv_("N",&n,&n,&sone,pjd->XpX,&ld,xx,&one,&zero,tt,&one));
    193:             PetscStackCallBLAS("BLAStrmv",BLAStrmv_("U","C","N",&n,pjd->Tj+ld*ld*i,&ld,tt,&one));
    194:             for (j=0;j<nconv;j++) y2[j] += tt[j];
    195:             if (i<pep->nmat-2) PetscStackCallBLAS("BLAStrmv",BLAStrmv_("U","N","N",&n,pjd->T,&ld,xx,&one));
    196:           }
    197:         }
    198:       }
    199:       VecResetArray(t2);
    200:       VecRestoreArray(v2,&array2);
    201:       BVRestoreColumn(pjd->TV[pp],col,&v2);
    202:     }
    203:     VecResetArray(t1);
    204:     VecRestoreArray(v1,&array1);
    205:     BVRestoreColumn(pjd->V,col,&v1);
    206:   }
    207:   PetscFree3(tt,x2,xx);
    208:   return(0);
    209: }

    213: /*
    214:    RRQR of X. Xin*P=Xou*R. Rank of R is rk
    215: */
    216: static PetscErrorCode PEPJDOrthogonalize(PetscInt row,PetscInt col,PetscScalar *X,PetscInt ldx,PetscInt *rk,PetscInt *P,PetscScalar *R,PetscInt ldr)
    217: {
    218: #if defined(SLEPC_MISSING_LAPACK_GEQP3)
    220:   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GEQP3 - Lapack routine is unavailable");
    221: #else
    223:   PetscInt       i,j,n,r;
    224:   PetscBLASInt   row_,col_,ldx_,*p,lwork,info,n_;
    225:   PetscScalar    *tau,*work;
    226:   PetscReal      tol,*rwork;

    229:   PetscBLASIntCast(row,&row_);
    230:   PetscBLASIntCast(col,&col_);
    231:   PetscBLASIntCast(ldx,&ldx_);
    232:   n = PetscMin(row,col);
    233:   PetscBLASIntCast(n,&n_);
    234:   lwork = 3*col_+1;
    235:   PetscMalloc4(col,&p,n,&tau,lwork,&work,2*col,&rwork);
    236:   for (i=1;i<col;i++) p[i] = 0;
    237:   p[0] = 1;

    239:   /* rank revealing QR */
    240: #if defined(PETSC_USE_COMPLEX)
    241:   PetscStackCallBLAS("LAPACKgeqp3",LAPACKgeqp3_(&row_,&col_,X,&ldx_,p,tau,work,&lwork,rwork,&info));
    242: #else
    243:   PetscStackCallBLAS("LAPACKgeqp3",LAPACKgeqp3_(&row_,&col_,X,&ldx_,p,tau,work,&lwork,&info));
    244: #endif
    245:   if (info) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in Lapack xGEQP3 %d",info);
    246:   if (P) for (i=0;i<col;i++) P[i] = p[i];

    248:   /* rank computation */
    249:   tol = PetscMax(row,col)*PETSC_MACHINE_EPSILON*PetscAbsScalar(X[0]);
    250:   r = 1;
    251:   for (i=1;i<n;i++) {
    252:     if (PetscAbsScalar(X[i+ldx*i])>tol) r++;
    253:     else break;
    254:   }
    255:   if (rk) *rk=r;

    257:   /* copy upper triangular matrix if requested */
    258:   if (R) {
    259:      for (i=0;i<r;i++) {
    260:        PetscMemzero(R+i*ldr,r*sizeof(PetscScalar));
    261:        for (j=0;j<=i;j++) R[i*ldr+j] = X[i*ldx+j];
    262:      }
    263:   }
    264:   PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&row_,&n_,&n_,X,&ldx_,tau,work,&lwork,&info));
    265:   if (info) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in Lapack xORGQR %d",info);
    266:   PetscFree4(p,tau,work,rwork);
    267:   return(0);
    268: #endif
    269: }

    273: /*
    274:    Application of extended preconditioner
    275: */
    276: static PetscErrorCode PEPJDExtendedPCApply(PC pc,Vec x,Vec y)
    277: {
    278:   PetscInt          i,j,nloc,n,ld;
    279:   PetscMPIInt       rk,np,count;
    280:   Vec               tx,ty;
    281:   PEP_JD_PCSHELL    *ctx;
    282:   PetscErrorCode    ierr;
    283:   const PetscScalar *array1;
    284:   PetscScalar       *x2=NULL,*t=NULL,*ps,*array2;
    285:   PetscBLASInt      one=1.0,ld_,n_;

    288:   PCShellGetContext(pc,(void**)&ctx);
    289:   n  = ctx->n;
    290:   ps = ctx->ps;
    291:   ld = ctx->ld;
    292:   if (n) {
    293:     PetscMalloc2(n,&x2,n,&t);
    294:     MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rk);
    295:     MPI_Comm_size(PetscObjectComm((PetscObject)pc),&np);
    296:     if (rk==np-1) {
    297:       VecGetLocalSize(ctx->work[0],&nloc);
    298:       VecGetArrayRead(x,&array1);
    299:       for (i=0;i<n;i++) x2[i] = array1[nloc+i];
    300:       VecRestoreArrayRead(x,&array1);
    301:     }
    302:     PetscMPIIntCast(n,&count);
    303:     MPI_Bcast(x2,count,MPIU_SCALAR,np-1,PetscObjectComm((PetscObject)pc));
    304:   }

    306:   /* y = B\x apply PC */
    307:   tx = ctx->work[0];
    308:   ty = ctx->work[1];
    309:   VecGetArrayRead(x,&array1);
    310:   VecPlaceArray(tx,array1);
    311:   VecGetArray(y,&array2);
    312:   VecPlaceArray(ty,array2);
    313:   PCApply(ctx->pc,tx,ty);
    314:   if (n) {
    315:     for (j=0;j<n;j++) {
    316:       t[j] = 0.0;
    317:       for (i=0;i<n;i++) t[j] += ctx->M[i+j*ld]*x2[i];
    318:     }
    319:     if (rk==np-1) for (i=0;i<n;i++) array2[nloc+i] = t[i];
    320:     PetscBLASIntCast(ld,&ld_);
    321:     PetscBLASIntCast(n,&n_);
    322:     PetscStackCallBLAS("BLAStrmv",BLAStrmv_("U","N","N",&n_,ps,&ld_,t,&one));
    323:     BVMultVec(ctx->X,-1.0,1.0,ty,t);
    324:     PetscFree2(x2,t);
    325:   }
    326:   VecResetArray(tx);
    327:   VecResetArray(ty);
    328:   VecRestoreArrayRead(x,&array1);
    329:   VecRestoreArray(y,&array2);
    330:   return(0);
    331: }

    335: /*
    336:    Application of shell preconditioner:
    337:       y = B\x - eta*B\p,  with eta = (u'*B\x)/(u'*B\p)
    338: */
    339: static PetscErrorCode PCShellApply_PEPJD(PC pc,Vec x,Vec y)
    340: {
    342:   PetscScalar    eta;
    343:   PEP_JD_PCSHELL *ctx;

    346:   PCShellGetContext(pc,(void**)&ctx);

    348:   /* y = B\x apply extended PC */
    349:   PEPJDExtendedPCApply(pc,x,y);

    351:   /* Compute eta = u'*y / u'*Bp */
    352:   VecDot(y,ctx->u,&eta);
    353:   eta /= ctx->gamma;
    354:
    355:   /* y = y - eta*Bp */
    356:   VecAXPY(y,-eta,ctx->Bp);
    357:   return(0);
    358: }

    362: static PetscErrorCode PEPJDCopyToExtendedVec(PEP pep,Vec v,PetscScalar *a,PetscInt na,PetscInt off,Vec vex,PetscBool back)
    363: {
    365:   PetscMPIInt    np,rk,count;
    366:   PetscScalar    *array1,*array2;
    367:   PetscInt       nloc;

    370:   MPI_Comm_rank(PetscObjectComm((PetscObject)pep),&rk);
    371:   MPI_Comm_size(PetscObjectComm((PetscObject)pep),&np);
    372:   BVGetSizes(pep->V,&nloc,NULL,NULL);
    373:   if (v) {
    374:     VecGetArray(v,&array1);
    375:     VecGetArray(vex,&array2);
    376:     if (back) {
    377:       PetscMemcpy(array1,array2,nloc*sizeof(PetscScalar));
    378:     } else {
    379:       PetscMemcpy(array2,array1,nloc*sizeof(PetscScalar));
    380:     }
    381:     VecRestoreArray(v,&array1);
    382:     VecRestoreArray(vex,&array2);
    383:   }
    384:   if (a) {
    385:     if (rk==np-1) {
    386:       VecGetArray(vex,&array2);
    387:       if (back) {
    388:         PetscMemcpy(a,array2+nloc+off,na*sizeof(PetscScalar));
    389:       } else {
    390:         PetscMemcpy(array2+nloc+off,a,na*sizeof(PetscScalar));
    391:       }
    392:       VecRestoreArray(vex,&array2);
    393:     }
    394:     if (back) {
    395:       PetscMPIIntCast(na,&count);
    396:       MPI_Bcast(a,count,MPIU_SCALAR,np-1,PetscObjectComm((PetscObject)pep));
    397:     }
    398:   }
    399:   return(0);
    400: }

    404: static PetscErrorCode PEPJDComputePResidual(PEP pep,Vec u,PetscScalar theta,Vec p,Vec *work)
    405: {
    406:   PEP_JD         *pjd = (PEP_JD*)pep->data;
    408:   PetscMPIInt    rk,np,count;
    409:   Vec            tu,tp,w;
    410:   PetscScalar    *array1,*array2,*x2=NULL,*y2,fact=1.0,*q=NULL,*tt=NULL,*xx=NULL,sone=1.0,zero=0.0;
    411:   PetscInt       i,j,nconv=pjd->nconv,nloc,deg=pep->nmat-1;
    412:   PetscBLASInt   n,ld,one=1;

    415:   if (nconv>0) {
    416:     PetscMalloc4(nconv,&xx,nconv,&tt,nconv,&x2,nconv,&q);
    417:     MPI_Comm_rank(PetscObjectComm((PetscObject)pep),&rk);
    418:     MPI_Comm_size(PetscObjectComm((PetscObject)pep),&np);
    419:     if (rk==np-1) {
    420:       BVGetSizes(pep->V,&nloc,NULL,NULL);
    421:       VecGetArray(u,&array1);
    422:       for (i=0;i<nconv;i++) x2[i] = array1[nloc+i];
    423:       VecRestoreArray(u,&array1);
    424:     }
    425:     PetscMPIIntCast(nconv,&count);
    426:     MPI_Bcast(x2,count,MPIU_SCALAR,np-1,PetscObjectComm((PetscObject)pep));
    427:   }
    428:   tu = work[0];
    429:   tp = work[1];
    430:   w  = work[2];
    431:   VecGetArray(u,&array1);
    432:   VecPlaceArray(tu,array1);
    433:   VecGetArray(p,&array2);
    434:   VecPlaceArray(tp,array2);
    435:   VecSet(tp,0.0);
    436:   for (i=1;i<pep->nmat;i++) {
    437:     MatMult(pep->A[i],tu,w);
    438:     VecAXPY(tp,fact*(PetscReal)i,w);
    439:     fact *= theta;
    440:   }
    441:   if (nconv) {
    442:     PetscBLASIntCast(nconv,&n);
    443:     PetscBLASIntCast(pep->nev,&ld);
    444:     for (j=0;j<nconv;j++) q[j] = x2[j];
    445:     fact = theta;
    446:     for (i=2;i<pep->nmat;i++) {
    447:       BVMultVec(pjd->AX[i],1.0,1.0,tp,q);
    448:       PetscStackCallBLAS("BLAStrmv",BLAStrmv_("U","N","N",&n,pjd->T,&ld,q,&one));
    449:       for (j=0;j<nconv;j++) q[j] += (PetscReal)i*fact*x2[j];
    450:       fact *= theta;
    451:     }
    452:     BVSetActiveColumns(pjd->X,0,nconv);
    453:     BVDotVec(pjd->X,tu,xx);
    454:     if (rk==np-1) {
    455:       y2 = array2+nloc;
    456:       for (i=0;i<nconv;i++) { q[i] = x2[i]; y2[i] = xx[i]; }
    457:       PetscStackCallBLAS("BLAStrmv",BLAStrmv_("U","C","N",&n,pjd->Tj+ld*ld,&ld,y2,&one));
    458:       fact = theta;
    459:       for (j=2;j<deg;j++) {
    460:         PetscStackCallBLAS("BLASgemv",BLASgemv_("N",&n,&n,&sone,pjd->XpX,&ld,q,&one,&zero,tt,&one));
    461:         for (i=0;i<nconv;i++) tt[i] += (PetscReal)j*fact*xx[i];
    462:         PetscStackCallBLAS("BLAStrmv",BLAStrmv_("U","C","N",&n,pjd->Tj+ld*ld*j,&ld,tt,&one));
    463:         for (i=0;i<nconv;i++) y2[i] += tt[i];
    464:         PetscStackCallBLAS("BLAStrmv",BLAStrmv_("U","N","N",&n,pjd->T,&ld,q,&one));
    465:         for (i=0;i<nconv;i++) q[i] += (PetscReal)j*fact*x2[i];
    466:         fact *= theta;
    467:       }
    468:     }
    469:     PetscFree4(xx,tt,x2,q);
    470:   }
    471:   VecResetArray(tu);
    472:   VecRestoreArray(u,&array1);
    473:   VecResetArray(tp);
    474:   VecRestoreArray(p,&array2);
    475:   return(0);
    476: }

    480: static PetscErrorCode PEPJDProcessInitialSpace(PEP pep,Vec *w)
    481: {
    482:   PEP_JD         *pjd = (PEP_JD*)pep->data;
    484:   PetscScalar    *tt;
    485:   Vec            vg,wg;
    486:   PetscInt       i;
    487:   PetscReal      norm;

    490:   PetscMalloc1(pep->nev-1,&tt);
    491:   if (pep->nini==0) {
    492:     BVSetRandomColumn(pjd->V,0);
    493:     for (i=0;i<pep->nev-1;i++) tt[i] = 0.0;
    494:     BVGetColumn(pjd->V,0,&vg);
    495:     PEPJDCopyToExtendedVec(pep,NULL,tt,pep->nev-1,0,vg,PETSC_FALSE);
    496:     BVRestoreColumn(pjd->V,0,&vg);
    497:     BVNormColumn(pjd->V,0,NORM_2,&norm);
    498:     BVScaleColumn(pjd->V,0,1.0/norm);
    499:     BVGetColumn(pjd->V,0,&vg);
    500:     BVGetColumn(pjd->W,0,&wg);
    501:     VecSet(wg,0.0);
    502:     PEPJDComputePResidual(pep,vg,pep->target,wg,w);
    503:     BVRestoreColumn(pjd->W,0,&wg);
    504:     BVRestoreColumn(pjd->V,0,&vg);
    505:     BVNormColumn(pjd->W,0,NORM_2,&norm);
    506:     BVScaleColumn(pjd->W,0,1.0/norm);
    507:   } else {
    508:    SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"TO DO");
    509:   }
    510:   PetscFree(tt);
    511:   return(0);
    512: }

    516: static PetscErrorCode PEPJDShellMatMult(Mat P,Vec x,Vec y)
    517: {
    518:   PetscErrorCode    ierr;
    519:   PEP_JD_MATSHELL   *matctx;
    520:   PEP_JD            *pjd;
    521:   PetscMPIInt       rk,np,count;
    522:   PetscInt          i,j,nconv,nloc,nmat,ldt,deg;
    523:   Vec               tx,ty;
    524:   PetscScalar       *array2,*x2=NULL,*y2,fact=1.0,*q=NULL,*tt=NULL,*xx=NULL,theta,*yy=NULL,sone=1.0,zero=0.0;
    525:   PetscBLASInt      n,ld,one=1;
    526:   const PetscScalar *array1;

    529:   MatShellGetContext(P,(void**)&matctx);
    530:   pjd   = (PEP_JD*)(matctx->pep->data);
    531:   nconv = pjd->nconv;
    532:   theta = matctx->theta;
    533:   nmat  = matctx->pep->nmat;
    534:   deg   = nmat-1;
    535:   ldt   = matctx->pep->nev;
    536:   if (nconv>0) {
    537:     PetscMalloc5(nconv,&tt,nconv,&x2,nconv,&q,nconv,&xx,nconv,&yy);
    538:     MPI_Comm_rank(PetscObjectComm((PetscObject)P),&rk);
    539:     MPI_Comm_size(PetscObjectComm((PetscObject)P),&np);
    540:     if (rk==np-1) {
    541:       BVGetSizes(matctx->pep->V,&nloc,NULL,NULL);
    542:       VecGetArrayRead(x,&array1);
    543:       for (i=0;i<nconv;i++) x2[i] = array1[nloc+i];
    544:       VecRestoreArrayRead(x,&array1);
    545:     }
    546:     PetscMPIIntCast(nconv,&count);
    547:     MPI_Bcast(x2,nconv,MPIU_SCALAR,np-1,PetscObjectComm((PetscObject)P));
    548:   }
    549:   tx = matctx->work[0];
    550:   ty = matctx->work[1];
    551:   VecGetArrayRead(x,&array1);
    552:   VecPlaceArray(tx,array1);
    553:   VecGetArray(y,&array2);
    554:   VecPlaceArray(ty,array2);
    555:   VecSet(ty,0.0);
    556:   MatMult(matctx->P,tx,ty);
    557:   if (nconv) {
    558:     PetscBLASIntCast(pjd->nconv,&n);
    559:     PetscBLASIntCast(ldt,&ld);
    560:     for (j=0;j<nconv;j++) q[j] = x2[j];
    561:     fact = theta;
    562:     for (i=1;i<nmat;i++) {
    563:       BVMultVec(pjd->AX[i],1.0,1.0,ty,q);
    564:       PetscStackCallBLAS("BLAStrmv",BLAStrmv_("U","N","N",&n,pjd->T,&ld,q,&one));
    565:       for (j=0;j<nconv;j++) q[j] += fact*x2[j];
    566:       fact *= theta;
    567:     }
    568:     BVSetActiveColumns(pjd->X,0,nconv);
    569:     BVDotVec(pjd->X,tx,xx);
    570:     if (rk==np-1) {
    571:       y2 = array2+nloc;
    572:       for (i=0;i<nconv;i++) { q[i] = x2[i]; y2[i] = xx[i]; }
    573:       fact = theta;
    574:       for (j=1;j<deg;j++) {
    575:         PetscStackCallBLAS("BLASgemv",BLASgemv_("N",&n,&n,&sone,pjd->XpX,&ld,q,&one,&zero,tt,&one));
    576:         for (i=0;i<nconv;i++) tt[i] += fact*xx[i];
    577:         PetscStackCallBLAS("BLAStrmv",BLAStrmv_("U","C","N",&n,pjd->Tj+ld*ld*j,&ld,tt,&one));
    578:         for (i=0;i<nconv;i++) y2[i] += tt[i];
    579:         PetscStackCallBLAS("BLAStrmv",BLAStrmv_("U","N","N",&n,pjd->T,&ld,q,&one));
    580:         for (i=0;i<nconv;i++) q[i] += fact*x2[i];
    581:         fact *= theta;
    582:       }
    583:     }
    584:     PetscFree5(tt,x2,q,xx,yy);
    585:   }
    586:   VecResetArray(tx);
    587:   VecRestoreArrayRead(x,&array1);
    588:   VecResetArray(ty);
    589:   VecRestoreArray(y,&array2);
    590:   return(0);
    591: }

    595: static PetscErrorCode PEPJDCreateShellPC(PEP pep)
    596: {
    597:   PEP_JD          *pjd = (PEP_JD*)pep->data;
    598:   PEP_JD_PCSHELL  *pcctx;
    599:   PEP_JD_MATSHELL *matctx;
    600:   KSP             ksp;
    601:   PetscInt        nloc,mloc;
    602:   PetscMPIInt     np,rk;
    603:   PetscErrorCode  ierr;

    606:   PCCreate(PetscObjectComm((PetscObject)pep),&pjd->pcshell);
    607:   PCSetType(pjd->pcshell,PCSHELL);
    608:   PCShellSetName(pjd->pcshell,"PCPEPJD");
    609:   PCShellSetApply(pjd->pcshell,PCShellApply_PEPJD);
    610:   PetscNew(&pcctx);
    611:   PCShellSetContext(pjd->pcshell,pcctx);
    612:   STGetKSP(pep->st,&ksp);
    613:   BVCreateVec(pjd->V,&pcctx->Bp);
    614:   KSPGetPC(ksp,&pcctx->pc);
    615:   PetscObjectReference((PetscObject)pcctx->pc);
    616:   MatGetLocalSize(pep->A[0],&mloc,&nloc);
    617:   if (pep->nev>1) {
    618:     MPI_Comm_rank(PetscObjectComm((PetscObject)pep),&rk);
    619:     MPI_Comm_size(PetscObjectComm((PetscObject)pep),&np);
    620:     if (rk==np-1) { nloc += pep->nev-1; mloc += pep->nev-1; }
    621:   }
    622:   PetscNew(&matctx);
    623:   MatCreateShell(PetscObjectComm((PetscObject)pep),nloc,mloc,PETSC_DETERMINE,PETSC_DETERMINE,matctx,&pjd->Pshell);
    624:   MatShellSetOperation(pjd->Pshell,MATOP_MULT,(void(*)())PEPJDShellMatMult);
    625:   matctx->pep = pep;
    626:   MatDuplicate(pep->A[0],MAT_DO_NOT_COPY_VALUES,&matctx->P);
    627:   PCSetOperators(pcctx->pc,matctx->P,matctx->P);
    628:   KSPSetPC(ksp,pjd->pcshell);
    629:   KSPSetOperators(ksp,pjd->Pshell,pjd->Pshell);
    630:   if (pep->nev>1) {
    631:     PetscMalloc2(pep->nev*pep->nev,&pcctx->M,pep->nev*pep->nev,&pcctx->ps);
    632:     pcctx->X  = pjd->X;
    633:     pcctx->ld = pep->nev;
    634:   }
    635:   return(0);
    636: }

    640: static PetscErrorCode PEPJDUpdateExtendedPC(PEP pep,PetscScalar theta)
    641: {
    643:   PEP_JD         *pjd = (PEP_JD*)pep->data;
    644:   PEP_JD_PCSHELL *pcctx;
    645:   PetscInt       i,j,k,n=pjd->nconv,ld=pep->nev,deg=pep->nmat-1;
    646:   PetscScalar    fact,*M,*ps,*work,*U,*V,*S,sone=1.0,zero=0.0;
    647:   PetscReal      tol,maxeig=0.0,*sg,*rwork;
    648:   PetscBLASInt   n_,info,ld_,*p,lw_,rk=0;

    651: #if defined(PETSC_MISSING_LAPACK_GESVD) || defined(PETSC_MISSING_LAPACK_GETRI) || defined(PETSC_MISSING_LAPACK_GETRF)
    653:   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GESVD/GETRI/GETRF - Lapack routine is unavailable");
    654: #else
    655:   if (n) {
    656:     PCShellGetContext(pjd->pcshell,(void**)&pcctx);
    657:     pcctx->n = n;
    658:     M  = pcctx->M;
    659:     ps = pcctx->ps;
    660:                       /* h, and q are vectors containing diagonal matrices */
    661:     PetscCalloc7(n*n,&U,n*n,&V,n*n,&S,n,&sg,10*n,&work,5*n,&rwork,n,&p);
    662:     /* pseudo-inverse */
    663:     for (j=0;j<n;j++) {
    664:       for (i=0;i<j;i++) S[n*j+i] = -pjd->T[pep->nev*j+i];
    665:       S[n*j+j] = theta-pjd->T[pep->nev*j+j];
    666:     }
    667:     PetscBLASIntCast(n,&n_);
    668:     PetscBLASIntCast(ld,&ld_);
    669:     lw_ = 10*n_;
    670: #if !defined (PETSC_USE_COMPLEX)
    671:     PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("S","S",&n_,&n_,S,&n_,sg,U,&n_,V,&n_,work,&lw_,&info));
    672: #else
    673:     PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("S","S",&n_,&n_,S,&n_,sg,U,&n_,V,&n_,work,&lw_,rwork,&info));
    674: #endif
    675:     for (i=0;i<n;i++) maxeig = PetscMax(maxeig,sg[i]);
    676:     tol = 10*PETSC_MACHINE_EPSILON*n*maxeig;
    677:     for (j=0;j<n;j++) {
    678:       if (sg[j]>tol) {
    679:         for (i=0;i<n;i++) U[j*n+i] /= sg[j];
    680:         rk++;
    681:       } else break;
    682:     }
    683:     PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&n_,&n_,&rk,&sone,U,&n_,V,&n_,&zero,ps,&ld_));

    685:     /* compute M */
    686:     PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&n_,&n_,&n_,&sone,pjd->XpX,&ld_,ps,&ld_,&zero,M,&ld_));
    687:     fact = theta;
    688:     PetscMemzero(S,n*n*sizeof(PetscScalar));
    689:     for (j=0;j<n;j++) S[j*(n+1)] = 1.0; /* q=S */
    690:     for (k=0;k<deg;k++) {
    691:       for (j=0;j<n;j++) for (i=0;i<n;i++) V[j*n+i] = S[j*n+i] + M[j*ld+i]*fact;
    692:       PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&n_,&n_,&n_,&sone,pjd->XpX,&ld_,V,&n_,&zero,U,&n_));
    693:       PetscStackCallBLAS("BLASgemm",BLASgemm_("C","N",&n_,&n_,&n_,&sone,pjd->Tj+k*ld*ld,&ld_,U,&n_,&sone,M,&ld_));
    694:       PetscStackCallBLAS("BLAStrmm",BLAStrmm_("L","U","N","N",&n_,&n_,&sone,pjd->T,&ld_,S,&n_));
    695:       for (j=0;j<n;j++) S[j*(n+1)] += fact;
    696:       fact *=theta;
    697:     }
    698:     /* inverse */
    699:     PetscStackCallBLAS("LAPACKgetrf",LAPACKgetrf_(&n_,&n_,M,&ld_,p,&info));
    700:     PetscStackCallBLAS("LAPACKgetri",LAPACKgetri_(&n_,M,&ld_,p,work,&n_,&info));
    701:     PetscFree7(U,V,S,sg,work,rwork,p);
    702:   }
    703:   return(0);
    704: #endif
    705: }

    709: static PetscErrorCode PEPJDPCMatSetUp(PEP pep,PetscScalar theta)
    710: {
    711:   PetscErrorCode  ierr;
    712:   PEP_JD          *pjd = (PEP_JD*)pep->data;
    713:   PEP_JD_MATSHELL *matctx;
    714:   PEP_JD_PCSHELL  *pcctx;
    715:   MatStructure    str;
    716:   PetscScalar     t;
    717:   PetscInt        i;

    720:   MatShellGetContext(pjd->Pshell,(void**)&matctx);
    721:   PCShellGetContext(pjd->pcshell,(void**)&pcctx);
    722:   STGetMatStructure(pep->st,&str);
    723:   MatCopy(pep->A[0],matctx->P,str);
    724:   t = theta;
    725:   for (i=1;i<pep->nmat;i++) {
    726:     if (t!=0.0) { MatAXPY(matctx->P,t,pep->A[i],str); }
    727:     t *= theta;
    728:   }
    729:   PCSetOperators(pcctx->pc,matctx->P,matctx->P);
    730:   PCSetUp(pcctx->pc);
    731:   matctx->theta = theta;
    732:   return(0);
    733: }

    737: static PetscErrorCode PEPJDEigenvectors(PEP pep)
    738: {
    740:   PEP_JD         *pjd = (PEP_JD*)pep->data;
    741:   PetscBLASInt   ld,nconv,info,nc;
    742:   PetscScalar    *Z,*w;
    743:   PetscReal      *wr,norm;
    744:   PetscInt       i;
    745:   Mat            U;
    746:
    748: #if defined(SLEPC_MISSING_LAPACK_TREVC)
    750:   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"TREVC - Lapack routine is unavailable");
    751: #else
    752:   PetscMalloc3(pjd->nconv*pjd->nconv,&Z,3*pep->nev,&wr,2*pep->nev,&w);
    753:   PetscBLASIntCast(pep->nev,&ld);
    754:   PetscBLASIntCast(pjd->nconv,&nconv);
    755: #if !defined(PETSC_USE_COMPLEX)
    756:   PetscStackCallBLAS("LAPACKtrevc",LAPACKtrevc_("R","A",NULL,&nconv,pjd->T,&ld,NULL,&nconv,Z,&nconv,&nconv,&nc,wr,&info));
    757: #else
    758:   PetscStackCallBLAS("LAPACKtrevc",LAPACKtrevc_("R","A",NULL,&nconv,pjd->T,&ld,NULL,&nconv,Z,&nconv,&nconv,&nc,w,wr,&info));
    759: #endif
    760:   MatCreateSeqDense(PETSC_COMM_SELF,nconv,nconv,Z,&U);
    761:   BVSetActiveColumns(pjd->X,0,pjd->nconv);
    762:   BVMultInPlace(pjd->X,U,0,pjd->nconv);
    763:   for (i=0;i<pjd->nconv;i++) {
    764:     BVNormColumn(pjd->X,i,NORM_2,&norm);
    765:     BVScaleColumn(pjd->X,i,1.0/norm);
    766:   }
    767:   MatDestroy(&U);
    768:   PetscFree3(Z,wr,w);
    769:   return(0);
    770: #endif
    771: }

    775: static PetscErrorCode PEPJDLockConverged(PEP pep,PetscInt *nv)
    776: {
    777:   PetscErrorCode    ierr;
    778:   PEP_JD            *pjd = (PEP_JD*)pep->data;
    779:   PetscInt          j,i,ldds,rk=0,*P,nvv=*nv;
    780:   Vec               v,x;
    781:   PetscBLASInt      n,ld,rk_,nv_,info,one=1;
    782:   PetscScalar       sone=1.0,*Tj,*R,*r,*tt,*pX;
    783:   Mat               X;

    786: #if defined(SLEPC_MISSING_LAPACK_TRTRI)
    788:   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"TRTRI - Lapack routine is unavailable");
    789: #else
    790:   /* update AX and XpX */
    791:   BVGetColumn(pjd->X,pjd->nconv-1,&x);
    792:   for (j=0;j<pep->nmat;j++) {
    793:     BVGetColumn(pjd->AX[j],pjd->nconv-1,&v);
    794:     MatMult(pep->A[j],x,v);
    795:     BVRestoreColumn(pjd->AX[j],pjd->nconv-1,&v);
    796:     BVSetActiveColumns(pjd->AX[j],0,pjd->nconv);
    797:   }
    798:   BVRestoreColumn(pjd->X,pjd->nconv-1,&x);
    799:   BVDotColumn(pjd->X,(pjd->nconv-1),pjd->XpX+(pjd->nconv-1)*(pep->nev));
    800:   pjd->XpX[(pjd->nconv-1)*(1+pep->nev)] = 1.0;
    801:   for (j=0;j<pjd->nconv-1;j++) pjd->XpX[j*(pep->nev)+pjd->nconv-1] = PetscConj(pjd->XpX[(pjd->nconv-1)*(pep->nev)+j]);
    802:
    803:   /* Compute powers of T */
    804:   PetscBLASIntCast(pjd->nconv,&n);
    805:   PetscBLASIntCast(pep->nev,&ld);
    806:   PetscMemzero(pjd->Tj,pep->nev*pep->nev*pep->nmat*sizeof(PetscScalar));
    807:   Tj = pjd->Tj;
    808:   for (j=0;j<pjd->nconv;j++) Tj[(pep->nev+1)*j] = 1.0;
    809:   Tj = pjd->Tj+pep->nev*pep->nev;
    810:   PetscMemcpy(Tj,pjd->T,pep->nev*pjd->nconv*sizeof(PetscScalar));
    811:   for (j=2;j<pep->nmat;j++) {
    812:     PetscMemcpy(Tj+pep->nev*pep->nev,Tj,pep->nev*pjd->nconv*sizeof(PetscScalar));
    813:     Tj += pep->nev*pep->nev;
    814:     PetscStackCallBLAS("BLAStrmm",BLAStrmm_("L","U","N","N",&n,&n,&sone,pjd->T,&ld,Tj,&ld));
    815:   }

    817:   /* Extend search space */
    818:   PetscCalloc4(nvv,&P,nvv*nvv,&R,nvv,&r,pep->nev-1,&tt);
    819:   DSGetLeadingDimension(pep->ds,&ldds);
    820:   DSGetArray(pep->ds,DS_MAT_X,&pX);
    821:   PEPJDOrthogonalize(nvv,nvv,pX,ldds,&rk,P,R,nvv);
    822:   for (i=0;i<rk-1;i++) r[i] = PetscConj(R[nvv*i]*pep->eigr[P[i+1]]); /* first row scaled with permuted diagonal */
    823:   PetscBLASIntCast(rk,&rk_);
    824:   PetscBLASIntCast(nvv,&nv_);
    825:   PetscStackCallBLAS("LAPACKtrtri",LAPACKtrtri_("U","N",&rk_,R,&nv_,&info));
    826:   if (info) SETERRQ1(PETSC_COMM_SELF,1,"Error in xTRTRI, info=%D",(PetscInt)info);
    827:   PetscStackCallBLAS("BLAStrmv",BLAStrmv_("U","C","N",&rk_,R,&nv_,r,&one));
    828:   for (i=0;i<rk;i++) r[i] = PetscConj(r[i]); /* revert */
    829:   BVSetActiveColumns(pjd->V,0,nvv);
    830:   for (j=0;j<rk-1;j++) {
    831:     PetscMemcpy(R+j*nvv,pX+(j+1)*ldds,nvv*sizeof(PetscScalar));
    832:   }
    833:   DSRestoreArray(pep->ds,DS_MAT_X,&pX);
    834:   MatCreateSeqDense(PETSC_COMM_SELF,nvv,rk-1,R,&X);
    835:   BVMultInPlace(pjd->V,X,0,rk-1);
    836:   MatDestroy(&X);
    837:   BVSetActiveColumns(pjd->V,0,rk-1);
    838:   for (j=0;j<rk-1;j++) {
    839:     BVGetColumn(pjd->V,j,&v);
    840:     PEPJDCopyToExtendedVec(pep,NULL,r+j,1,pjd->nconv-1,v,PETSC_FALSE);
    841:     BVRestoreColumn(pjd->V,j,&v);
    842:   }
    843:   BVOrthogonalize(pjd->V,NULL);
    844:   for (j=0;j<rk-1;j++) {
    845:     BVGetColumn(pjd->W,j,&v);
    846:     PEPJDCopyToExtendedVec(pep,NULL,tt,pep->nev-1,0,v,PETSC_FALSE);
    847:     BVRestoreColumn(pjd->W,j,&v);
    848:   }
    849:   *nv = rk-1;
    850:   PetscFree4(P,R,r,tt);
    851: #endif
    852:   return(0);
    853: }

    857: PetscErrorCode PEPSolve_JD(PEP pep)
    858: {
    859:   PetscErrorCode  ierr;
    860:   PEP_JD          *pjd = (PEP_JD*)pep->data;
    861:   PetscInt        k,nv,ld,minv,low,high,dim;
    862:   PetscScalar     theta=0.0,*pX,*eig;
    863:   PetscReal       norm,*res;
    864:   PetscBool       lindep,initial=PETSC_FALSE,flglk=PETSC_FALSE,flgre=PETSC_FALSE;
    865:   Vec             t,u,p,r,*ww=pep->work,v;
    866:   Mat             G,X,Y;
    867:   KSP             ksp;
    868:   PEP_JD_PCSHELL  *pcctx;
    869:   PEP_JD_MATSHELL *matctx;

    872:   DSGetLeadingDimension(pep->ds,&ld);
    873:   PetscMalloc2(pep->ncv,&eig,pep->ncv,&res);
    874:   BVCreateVec(pjd->V,&u);
    875:   VecDuplicate(u,&p);
    876:   VecDuplicate(u,&r);
    877:   STGetKSP(pep->st,&ksp);

    879:   if (pep->nini) {
    880:     nv = pep->nini; initial = PETSC_TRUE;
    881:   } else {
    882:     theta = pep->target;
    883:     nv = 1;
    884:   }
    885:   PEPJDProcessInitialSpace(pep,ww);
    886:   BVCopyVec(pjd->V,0,u);

    888:   /* Restart loop */
    889:   while (pep->reason == PEP_CONVERGED_ITERATING) {
    890:     pep->its++;

    892:     low = (flglk || flgre)? 0: nv-1;
    893:     high = nv;
    894:     DSSetDimensions(pep->ds,nv,0,0,0);
    895:     BVSetActiveColumns(pjd->V,low,high);
    896:     PEPJDUpdateTV(pep,low,high,ww);
    897:     BVSetActiveColumns(pjd->W,low,high);
    898:     for (k=0;k<pep->nmat;k++) {
    899:       BVSetActiveColumns(pjd->TV[k],low,high);
    900:       DSGetMat(pep->ds,DSMatExtra[k],&G);
    901:       BVMatProject(pjd->TV[k],NULL,pjd->W,G);
    902:       DSRestoreMat(pep->ds,DSMatExtra[k],&G);
    903:     }
    904:     BVSetActiveColumns(pjd->V,0,nv);
    905:     BVSetActiveColumns(pjd->W,0,nv);

    907:     /* Solve projected problem */
    908:     if (nv>1 || initial ) {
    909:       DSSetState(pep->ds,DS_STATE_RAW);
    910:       DSSolve(pep->ds,pep->eigr+pep->nconv,pep->eigi+pep->nconv);
    911:       DSSort(pep->ds,pep->eigr+pep->nconv,pep->eigi+pep->nconv,NULL,NULL,NULL);
    912:       theta = pep->eigr[0];
    913: #if !defined(PETSC_USE_COMPLEX)
    914:       if (PetscAbsScalar(pep->eigi[pep->nconv])!=0.0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"PJD solver not implemented for complex Ritz values in real arithmetic");
    915: #endif

    917:       /* Compute Ritz vector u=V*X(:,1) */
    918:       DSGetArray(pep->ds,DS_MAT_X,&pX);
    919:       BVSetActiveColumns(pjd->V,0,nv);
    920:       BVMultVec(pjd->V,1.0,0.0,u,pX);
    921:       DSRestoreArray(pep->ds,DS_MAT_X,&pX);
    922:     }
    923:     PEPJDUpdateExtendedPC(pep,theta);

    925:     /* Replace preconditioner with one containing projectors */
    926:     if (!pjd->pcshell) {
    927:       PEPJDCreateShellPC(pep);
    928:       PCShellGetContext(pjd->pcshell,(void**)&pcctx);
    929:       MatShellGetContext(pjd->Pshell,(void**)&matctx);
    930:       matctx->work = ww;
    931:       pcctx->work  = ww;
    932:     }
    933:     PEPJDPCMatSetUp(pep,theta);
    934:
    935:     /* Compute r and r' */
    936:     MatMult(pjd->Pshell,u,r);
    937:     PEPJDComputePResidual(pep,u,theta,p,ww);
    938:     pcctx->u = u;

    940:     /* Check convergence */
    941:     VecNorm(r,NORM_2,&norm);
    942:     (*pep->converged)(pep,theta,0,norm,&pep->errest[pep->nconv],pep->convergedctx);
    943:     (*pep->stopping)(pep,pep->its,pep->max_it,(pep->errest[pep->nconv]<pep->tol)?pjd->nconv+1:pjd->nconv,pep->nev,&pep->reason,pep->stoppingctx);

    945:     if (pep->errest[pep->nconv]<pep->tol) {

    947:       /* Ritz pair converged */
    948:       minv = PetscMin(nv,(PetscInt)(pjd->keep*pep->ncv));
    949:       if (pep->nev>1) {
    950:         BVGetColumn(pjd->X,pjd->nconv,&v);
    951:         PEPJDCopyToExtendedVec(pep,v,pjd->T+pep->nev*pjd->nconv,pep->nev-1,0,u,PETSC_TRUE);
    952:         BVRestoreColumn(pjd->X,pjd->nconv,&v);
    953:         BVSetActiveColumns(pjd->X,0,pjd->nconv+1);
    954:         BVNormColumn(pjd->X,pjd->nconv,NORM_2,&norm);
    955:         BVScaleColumn(pjd->X,pjd->nconv,1.0/norm);
    956:         for (k=0;k<pjd->nconv;k++) pjd->T[pep->nev*pjd->nconv+k] /= norm;
    957:         pjd->T[(pep->nev+1)*pjd->nconv] = pep->eigr[0];
    958:       } else {
    959:         BVInsertVec(pep->V,pep->nconv,u);
    960:       }
    961:       pjd->nconv++;

    963:       if (pep->reason==PEP_CONVERGED_ITERATING) {
    964:         PEPJDLockConverged(pep,&nv);
    965:         BVCopyVec(pjd->V,nv-1,u);
    966:         if (nv==1) theta = pep->target;
    967:       }
    968:       flglk = PETSC_TRUE;
    969:     } else if (nv==pep->ncv-1) {

    971:       /* Basis full, force restart */
    972:       minv = PetscMin(nv,(PetscInt)(pjd->keep*pep->ncv));
    973:       DSGetDimensions(pep->ds,&dim,NULL,NULL,NULL,NULL);
    974:       DSGetArray(pep->ds,DS_MAT_X,&pX);
    975:       PEPJDOrthogonalize(dim,minv,pX,ld,&minv,NULL,NULL,ld);
    976:       DSRestoreArray(pep->ds,DS_MAT_X,&pX);
    977:       DSGetArray(pep->ds,DS_MAT_Y,&pX);
    978:       PEPJDOrthogonalize(dim,minv,pX,ld,&minv,NULL,NULL,ld);
    979:       DSRestoreArray(pep->ds,DS_MAT_Y,&pX);
    980:       DSGetMat(pep->ds,DS_MAT_X,&X);
    981:       BVMultInPlace(pjd->V,X,pep->nconv,minv);
    982:       DSRestoreMat(pep->ds,DS_MAT_X,&X);
    983:       DSGetMat(pep->ds,DS_MAT_Y,&Y);
    984:       BVMultInPlace(pjd->W,Y,pep->nconv,minv);
    985:       DSRestoreMat(pep->ds,DS_MAT_Y,&Y);
    986:       nv = minv;
    987:       flgre = PETSC_TRUE;
    988:     } else {
    989:       /* Solve correction equation to expand basis */
    990:       PEPJDExtendedPCApply(pjd->pcshell,p,pcctx->Bp);
    991:       VecDot(pcctx->Bp,u,&pcctx->gamma);
    992:       BVGetColumn(pjd->V,nv,&t);
    993:       KSPSolve(ksp,r,t);
    994:       BVRestoreColumn(pjd->V,nv,&t);
    995:       BVOrthogonalizeColumn(pjd->V,nv,NULL,&norm,&lindep);
    996:       if (lindep || norm==0.0) SETERRQ(PETSC_COMM_SELF,1,"Linearly dependent continuation vector");
    997:       BVScaleColumn(pjd->V,nv,1.0/norm);
    998:       BVInsertVec(pjd->W,nv,r);
    999:       BVOrthogonalizeColumn(pjd->W,nv,NULL,&norm,&lindep);
    1000:       if (lindep) SETERRQ(PETSC_COMM_SELF,1,"Linearly dependent continuation vector");
    1001:       BVScaleColumn(pjd->W,nv,1.0/norm);
    1002:       nv++;
    1003:       flglk = PETSC_FALSE;
    1004:       flgre = PETSC_FALSE;
    1005:     }
    1006:     for (k=pjd->nconv;k<nv;k++) {
    1007:       eig[k] = pep->eigr[k-pjd->nconv];
    1008:       res[k] = pep->errest[k-pjd->nconv];
    1009: #if !defined(PETSC_USE_COMPLEX)
    1010:       pep->eigi[k-pjd->nconv] = 0.0;
    1011: #endif
    1012:     }
    1013:     PEPMonitor(pep,pep->its,pjd->nconv,eig,pep->eigi,res,pjd->nconv+1);
    1014:   }
    1015:   if (pep->nev>1) {
    1016:     if (pjd->nconv>0) { PEPJDEigenvectors(pep); }
    1017:     for (k=0;k<pjd->nconv;k++) {
    1018:       BVGetColumn(pjd->X,k,&v);
    1019:       BVInsertVec(pep->V,k,v);
    1020:       BVRestoreColumn(pjd->X,k,&v);
    1021:       pep->eigr[k] = pjd->T[(pep->nev+1)*k];
    1022:       pep->eigi[k] = 0.0;
    1023:     }
    1024:     PetscFree2(pcctx->M,pcctx->ps);
    1025:   }
    1026:   pep->nconv = pjd->nconv;
    1027:   KSPSetPC(ksp,pcctx->pc);
    1028:   MatDestroy(&matctx->P);
    1029:   VecDestroy(&pcctx->Bp);
    1030:   MatDestroy(&pjd->Pshell);
    1031:   PCDestroy(&pcctx->pc);
    1032:   PetscFree(pcctx);
    1033:   PetscFree(matctx);
    1034:   PCDestroy(&pjd->pcshell);
    1035:   PetscFree2(eig,res);
    1036:   VecDestroy(&u);
    1037:   VecDestroy(&r);
    1038:   VecDestroy(&p);
    1039:   return(0);
    1040: }

    1044: PetscErrorCode PEPReset_JD(PEP pep)
    1045: {
    1047:   PEP_JD         *pjd = (PEP_JD*)pep->data;
    1048:   PetscInt       i;

    1051:   for (i=0;i<pep->nmat;i++) {
    1052:     BVDestroy(pjd->TV+i);
    1053:   }
    1054:   BVDestroy(&pjd->W);
    1055:   if (pep->nev>1) {
    1056:     BVDestroy(&pjd->V);
    1057:     for (i=0;i<pep->nmat;i++) {
    1058:       BVDestroy(pjd->AX+i);
    1059:     }
    1060:     BVDestroy(&pjd->X);
    1061:     PetscFree3(pjd->XpX,pjd->T,pjd->Tj);
    1062:   }
    1063:   PetscFree2(pjd->TV,pjd->AX);
    1064:   return(0);
    1065: }

    1069: PetscErrorCode PEPDestroy_JD(PEP pep)
    1070: {

    1074:   PetscFree(pep->data);
    1075:   PetscObjectComposeFunction((PetscObject)pep,"PEPJDSetRestart_C",NULL);
    1076:   PetscObjectComposeFunction((PetscObject)pep,"PEPJDGetRestart_C",NULL);
    1077:   return(0);
    1078: }

    1082: PETSC_EXTERN PetscErrorCode PEPCreate_JD(PEP pep)
    1083: {
    1084:   PEP_JD         *pjd;

    1088:   PetscNewLog(pep,&pjd);
    1089:   pep->data = (void*)pjd;

    1091:   pjd->keep = 0;
    1092:   pep->ops->solve          = PEPSolve_JD;
    1093:   pep->ops->setup          = PEPSetUp_JD;
    1094:   pep->ops->setfromoptions = PEPSetFromOptions_JD;
    1095:   pep->ops->reset          = PEPReset_JD;
    1096:   pep->ops->destroy        = PEPDestroy_JD;
    1097:   pep->ops->view           = PEPView_JD;
    1098:   PetscObjectComposeFunction((PetscObject)pep,"PEPJDSetRestart_C",PEPJDSetRestart_JD);
    1099:   PetscObjectComposeFunction((PetscObject)pep,"PEPJDGetRestart_C",PEPJDGetRestart_JD);
    1100:   return(0);
    1101: }