Actual source code: dspep.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: */

     11: #include <slepc/private/dsimpl.h>
     12: #include <slepcblaslapack.h>

     14: typedef struct {
     15:   PetscInt  d;              /* polynomial degree */
     16:   PetscReal *pbc;           /* polynomial basis coefficients */
     17: } DS_PEP;

     19: static PetscErrorCode DSAllocate_PEP(DS ds,PetscInt ld)
     20: {
     21:   DS_PEP         *ctx = (DS_PEP*)ds->data;
     22:   PetscInt       i;

     24:   PetscFunctionBegin;
     25:   PetscCheck(ctx->d,PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_WRONGSTATE,"DSPEP requires specifying the polynomial degree via DSPEPSetDegree()");
     26:   PetscCall(DSAllocateMat_Private(ds,DS_MAT_X));
     27:   PetscCall(DSAllocateMat_Private(ds,DS_MAT_Y));
     28:   for (i=0;i<=ctx->d;i++) PetscCall(DSAllocateMat_Private(ds,DSMatExtra[i]));
     29:   PetscCall(PetscFree(ds->perm));
     30:   PetscCall(PetscMalloc1(ld*ctx->d,&ds->perm));
     31:   PetscFunctionReturn(PETSC_SUCCESS);
     32: }

     34: static PetscErrorCode DSView_PEP(DS ds,PetscViewer viewer)
     35: {
     36:   DS_PEP            *ctx = (DS_PEP*)ds->data;
     37:   PetscViewerFormat format;
     38:   PetscInt          i;

     40:   PetscFunctionBegin;
     41:   PetscCall(PetscViewerGetFormat(viewer,&format));
     42:   if (format == PETSC_VIEWER_ASCII_INFO) PetscFunctionReturn(PETSC_SUCCESS);
     43:   if (format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
     44:     PetscCall(PetscViewerASCIIPrintf(viewer,"polynomial degree: %" PetscInt_FMT "\n",ctx->d));
     45:     PetscFunctionReturn(PETSC_SUCCESS);
     46:   }
     47:   for (i=0;i<=ctx->d;i++) PetscCall(DSViewMat(ds,viewer,DSMatExtra[i]));
     48:   if (ds->state>DS_STATE_INTERMEDIATE) PetscCall(DSViewMat(ds,viewer,DS_MAT_X));
     49:   PetscFunctionReturn(PETSC_SUCCESS);
     50: }

     52: static PetscErrorCode DSVectors_PEP(DS ds,DSMatType mat,PetscInt *j,PetscReal *rnorm)
     53: {
     54:   PetscFunctionBegin;
     55:   PetscCheck(!rnorm,PetscObjectComm((PetscObject)ds),PETSC_ERR_SUP,"Not implemented yet");
     56:   switch (mat) {
     57:     case DS_MAT_X:
     58:       break;
     59:     case DS_MAT_Y:
     60:       break;
     61:     default:
     62:       SETERRQ(PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_OUTOFRANGE,"Invalid mat parameter");
     63:   }
     64:   PetscFunctionReturn(PETSC_SUCCESS);
     65: }

     67: static PetscErrorCode DSSort_PEP(DS ds,PetscScalar *wr,PetscScalar *wi,PetscScalar *rr,PetscScalar *ri,PetscInt *kout)
     68: {
     69:   DS_PEP         *ctx = (DS_PEP*)ds->data;
     70:   PetscInt       n,i,*perm,told;
     71:   PetscScalar    *A;

     73:   PetscFunctionBegin;
     74:   if (!ds->sc) PetscFunctionReturn(PETSC_SUCCESS);
     75:   n = ds->n*ctx->d;
     76:   perm = ds->perm;
     77:   for (i=0;i<n;i++) perm[i] = i;
     78:   told = ds->t;
     79:   ds->t = n;  /* force the sorting routines to consider d*n eigenvalues */
     80:   if (rr) PetscCall(DSSortEigenvalues_Private(ds,rr,ri,perm,PETSC_FALSE));
     81:   else PetscCall(DSSortEigenvalues_Private(ds,wr,wi,perm,PETSC_FALSE));
     82:   ds->t = told;  /* restore value of t */
     83:   PetscCall(MatDenseGetArray(ds->omat[DS_MAT_A],&A));
     84:   for (i=0;i<n;i++) A[i]  = wr[perm[i]];
     85:   for (i=0;i<n;i++) wr[i] = A[i];
     86:   for (i=0;i<n;i++) A[i]  = wi[perm[i]];
     87:   for (i=0;i<n;i++) wi[i] = A[i];
     88:   PetscCall(MatDenseRestoreArray(ds->omat[DS_MAT_A],&A));
     89:   PetscCall(DSPermuteColumnsTwo_Private(ds,0,n,ds->n,DS_MAT_X,DS_MAT_Y,perm));
     90:   PetscFunctionReturn(PETSC_SUCCESS);
     91: }

     93: static PetscErrorCode DSSolve_PEP_QZ(DS ds,PetscScalar *wr,PetscScalar *wi)
     94: {
     95:   DS_PEP            *ctx = (DS_PEP*)ds->data;
     96:   PetscInt          i,j,k,off;
     97:   PetscScalar       *A,*B,*W,*X,*U,*Y,*work,*beta,a;
     98:   const PetscScalar *Ed,*Ei;
     99:   PetscReal         *ca,*cb,*cg,norm,done=1.0;
    100:   PetscBLASInt      info,n,ld,ldd,nd,lwork,one=1,zero=0,cols;
    101:   PetscBool         useggev3=(ds->method==1)?PETSC_TRUE:PETSC_FALSE;

    103:   PetscFunctionBegin;
    104:   PetscCall(PetscBLASIntCast(ds->n*ctx->d,&nd));
    105:   PetscCall(PetscBLASIntCast(ds->n,&n));
    106:   PetscCall(PetscBLASIntCast(ds->ld,&ld));
    107:   PetscCall(PetscBLASIntCast(ds->ld*ctx->d,&ldd));
    108:   PetscCall(DSAllocateMat_Private(ds,DS_MAT_A));
    109:   PetscCall(DSAllocateMat_Private(ds,DS_MAT_B));
    110:   PetscCall(DSAllocateMat_Private(ds,DS_MAT_W));
    111:   PetscCall(DSAllocateMat_Private(ds,DS_MAT_U));
    112:   PetscCall(MatDenseGetArray(ds->omat[DS_MAT_A],&A));
    113:   PetscCall(MatDenseGetArray(ds->omat[DS_MAT_B],&B));

    115:   /* build matrices A and B of the linearization */
    116:   PetscCall(MatDenseGetArrayRead(ds->omat[DSMatExtra[ctx->d]],&Ed));
    117:   PetscCall(PetscArrayzero(A,ldd*ldd));
    118:   if (!ctx->pbc) { /* monomial basis */
    119:     for (i=0;i<nd-ds->n;i++) A[i+(i+ds->n)*ldd] = 1.0;
    120:     for (i=0;i<ctx->d;i++) {
    121:       PetscCall(MatDenseGetArrayRead(ds->omat[DSMatExtra[i]],&Ei));
    122:       off = i*ds->n*ldd+(ctx->d-1)*ds->n;
    123:       for (j=0;j<ds->n;j++) PetscCall(PetscArraycpy(A+off+j*ldd,Ei+j*ds->ld,ds->n));
    124:       PetscCall(MatDenseRestoreArrayRead(ds->omat[DSMatExtra[i]],&Ei));
    125:     }
    126:   } else {
    127:     ca = ctx->pbc;
    128:     cb = ca+ctx->d+1;
    129:     cg = cb+ctx->d+1;
    130:     for (i=0;i<ds->n;i++) {
    131:       A[i+(i+ds->n)*ldd] = ca[0];
    132:       A[i+i*ldd] = cb[0];
    133:     }
    134:     for (;i<nd-ds->n;i++) {
    135:       j = i/ds->n;
    136:       A[i+(i+ds->n)*ldd] = ca[j];
    137:       A[i+i*ldd] = cb[j];
    138:       A[i+(i-ds->n)*ldd] = cg[j];
    139:     }
    140:     for (i=0;i<ctx->d-2;i++) {
    141:       PetscCall(MatDenseGetArrayRead(ds->omat[DSMatExtra[i]],&Ei));
    142:       off = i*ds->n*ldd+(ctx->d-1)*ds->n;
    143:       for (j=0;j<ds->n;j++)
    144:         for (k=0;k<ds->n;k++)
    145:           A[off+j*ldd+k] = Ei[j*ds->ld+k]*ca[ctx->d-1];
    146:       PetscCall(MatDenseRestoreArrayRead(ds->omat[DSMatExtra[i]],&Ei));
    147:     }
    148:     PetscCall(MatDenseGetArrayRead(ds->omat[DSMatExtra[i]],&Ei));
    149:     off = i*ds->n*ldd+(ctx->d-1)*ds->n;
    150:     for (j=0;j<ds->n;j++)
    151:       for (k=0;k<ds->n;k++)
    152:         A[off+j*ldd+k] = Ei[j*ds->ld+k]*ca[ctx->d-1]-Ed[j*ds->ld+k]*cg[ctx->d-1];
    153:     PetscCall(MatDenseRestoreArrayRead(ds->omat[DSMatExtra[i]],&Ei));
    154:     i++;
    155:     PetscCall(MatDenseGetArrayRead(ds->omat[DSMatExtra[i]],&Ei));
    156:     off = i*ds->n*ldd+(ctx->d-1)*ds->n;
    157:     for (j=0;j<ds->n;j++)
    158:       for (k=0;k<ds->n;k++)
    159:         A[off+j*ldd+k] = Ei[j*ds->ld+k]*ca[ctx->d-1]-Ed[j*ds->ld+k]*cb[ctx->d-1];
    160:     PetscCall(MatDenseRestoreArrayRead(ds->omat[DSMatExtra[i]],&Ei));
    161:   }
    162:   PetscCall(PetscArrayzero(B,ldd*ldd));
    163:   for (i=0;i<nd-ds->n;i++) B[i+i*ldd] = 1.0;
    164:   off = (ctx->d-1)*ds->n*(ldd+1);
    165:   for (j=0;j<ds->n;j++) {
    166:     for (i=0;i<ds->n;i++) B[off+i+j*ldd] = -Ed[i+j*ds->ld];
    167:   }
    168:   PetscCall(MatDenseRestoreArrayRead(ds->omat[DSMatExtra[ctx->d]],&Ed));

    170:   /* solve generalized eigenproblem */
    171:   PetscCall(MatDenseGetArray(ds->omat[DS_MAT_W],&W));
    172:   PetscCall(MatDenseGetArray(ds->omat[DS_MAT_U],&U));
    173:   lwork = -1;
    174: #if defined(PETSC_USE_COMPLEX)
    175:   if (useggev3) PetscCallBLAS("LAPACKggev3",LAPACKggev3_("V","V",&nd,A,&ldd,B,&ldd,wr,NULL,U,&ldd,W,&ldd,&a,&lwork,NULL,&info));
    176:   else PetscCallBLAS("LAPACKggev",LAPACKggev_("V","V",&nd,A,&ldd,B,&ldd,wr,NULL,U,&ldd,W,&ldd,&a,&lwork,NULL,&info));
    177:   PetscCall(PetscBLASIntCast((PetscInt)PetscRealPart(a),&lwork));
    178:   PetscCall(DSAllocateWork_Private(ds,lwork+nd,8*nd,0));
    179:   beta  = ds->work;
    180:   work  = ds->work + nd;
    181:   if (useggev3) PetscCallBLAS("LAPACKggev3",LAPACKggev3_("V","V",&nd,A,&ldd,B,&ldd,wr,beta,U,&ldd,W,&ldd,work,&lwork,ds->rwork,&info));
    182:   else PetscCallBLAS("LAPACKggev",LAPACKggev_("V","V",&nd,A,&ldd,B,&ldd,wr,beta,U,&ldd,W,&ldd,work,&lwork,ds->rwork,&info));
    183: #else
    184:   if (useggev3) PetscCallBLAS("LAPACKggev3",LAPACKggev3_("V","V",&nd,A,&ldd,B,&ldd,wr,wi,NULL,U,&ldd,W,&ldd,&a,&lwork,&info));
    185:   else PetscCallBLAS("LAPACKggev",LAPACKggev_("V","V",&nd,A,&ldd,B,&ldd,wr,wi,NULL,U,&ldd,W,&ldd,&a,&lwork,&info));
    186:   PetscCall(PetscBLASIntCast((PetscInt)a,&lwork));
    187:   PetscCall(DSAllocateWork_Private(ds,lwork+nd,0,0));
    188:   beta = ds->work;
    189:   work = ds->work + nd;
    190:   if (useggev3) PetscCallBLAS("LAPACKggev3",LAPACKggev3_("V","V",&nd,A,&ldd,B,&ldd,wr,wi,beta,U,&ldd,W,&ldd,work,&lwork,&info));
    191:   else PetscCallBLAS("LAPACKggev",LAPACKggev_("V","V",&nd,A,&ldd,B,&ldd,wr,wi,beta,U,&ldd,W,&ldd,work,&lwork,&info));
    192: #endif
    193:   SlepcCheckLapackInfo(useggev3?"ggev3":"ggev",info);
    194:   PetscCall(MatDenseRestoreArray(ds->omat[DS_MAT_A],&A));
    195:   PetscCall(MatDenseRestoreArray(ds->omat[DS_MAT_B],&B));

    197:   /* copy eigenvalues */
    198:   for (i=0;i<nd;i++) {
    199:     if (beta[i]==0.0) wr[i] = (PetscRealPart(wr[i])>0.0)? PETSC_MAX_REAL: PETSC_MIN_REAL;
    200:     else wr[i] /= beta[i];
    201: #if !defined(PETSC_USE_COMPLEX)
    202:     if (beta[i]==0.0) wi[i] = 0.0;
    203:     else wi[i] /= beta[i];
    204: #else
    205:     if (wi) wi[i] = 0.0;
    206: #endif
    207:   }

    209:   /* copy and normalize eigenvectors */
    210:   PetscCall(MatDenseGetArray(ds->omat[DS_MAT_X],&X));
    211:   PetscCall(MatDenseGetArray(ds->omat[DS_MAT_Y],&Y));
    212:   for (j=0;j<nd;j++) {
    213:     PetscCall(PetscArraycpy(X+j*ds->ld,W+j*ldd,ds->n));
    214:     PetscCall(PetscArraycpy(Y+j*ds->ld,U+ds->n*(ctx->d-1)+j*ldd,ds->n));
    215:   }
    216:   PetscCall(MatDenseRestoreArray(ds->omat[DS_MAT_W],&W));
    217:   PetscCall(MatDenseRestoreArray(ds->omat[DS_MAT_U],&U));
    218:   for (j=0;j<nd;j++) {
    219:     cols = 1;
    220:     norm = BLASnrm2_(&n,X+j*ds->ld,&one);
    221: #if !defined(PETSC_USE_COMPLEX)
    222:     if (wi[j] != 0.0) {
    223:       norm = SlepcAbsEigenvalue(norm,BLASnrm2_(&n,X+(j+1)*ds->ld,&one));
    224:       cols = 2;
    225:     }
    226: #endif
    227:     PetscCallBLAS("LAPACKlascl",LAPACKlascl_("G",&zero,&zero,&norm,&done,&n,&cols,X+j*ds->ld,&ld,&info));
    228:     SlepcCheckLapackInfo("lascl",info);
    229:     norm = BLASnrm2_(&n,Y+j*ds->ld,&one);
    230: #if !defined(PETSC_USE_COMPLEX)
    231:     if (wi[j] != 0.0) norm = SlepcAbsEigenvalue(norm,BLASnrm2_(&n,Y+(j+1)*ds->ld,&one));
    232: #endif
    233:     PetscCallBLAS("LAPACKlascl",LAPACKlascl_("G",&zero,&zero,&norm,&done,&n,&cols,Y+j*ds->ld,&ld,&info));
    234:     SlepcCheckLapackInfo("lascl",info);
    235: #if !defined(PETSC_USE_COMPLEX)
    236:     if (wi[j] != 0.0) j++;
    237: #endif
    238:   }
    239:   PetscCall(MatDenseRestoreArray(ds->omat[DS_MAT_X],&X));
    240:   PetscCall(MatDenseRestoreArray(ds->omat[DS_MAT_Y],&Y));
    241:   PetscFunctionReturn(PETSC_SUCCESS);
    242: }

    244: #if !defined(PETSC_HAVE_MPIUNI)
    245: static PetscErrorCode DSSynchronize_PEP(DS ds,PetscScalar eigr[],PetscScalar eigi[])
    246: {
    247:   DS_PEP         *ctx = (DS_PEP*)ds->data;
    248:   PetscInt       ld=ds->ld,k=0;
    249:   PetscMPIInt    ldnd,rank,off=0,size,dn;
    250:   PetscScalar    *X,*Y;

    252:   PetscFunctionBegin;
    253:   if (ds->state>=DS_STATE_CONDENSED) k += 2*ctx->d*ds->n*ld;
    254:   if (eigr) k += ctx->d*ds->n;
    255:   if (eigi) k += ctx->d*ds->n;
    256:   PetscCall(DSAllocateWork_Private(ds,k,0,0));
    257:   PetscCall(PetscMPIIntCast(k*sizeof(PetscScalar),&size));
    258:   PetscCall(PetscMPIIntCast(ds->n*ctx->d*ld,&ldnd));
    259:   PetscCall(PetscMPIIntCast(ctx->d*ds->n,&dn));
    260:   if (ds->state>=DS_STATE_CONDENSED) {
    261:     PetscCall(MatDenseGetArray(ds->omat[DS_MAT_X],&X));
    262:     PetscCall(MatDenseGetArray(ds->omat[DS_MAT_Y],&Y));
    263:   }
    264:   PetscCallMPI(MPI_Comm_rank(PetscObjectComm((PetscObject)ds),&rank));
    265:   if (!rank) {
    266:     if (ds->state>=DS_STATE_CONDENSED) {
    267:       PetscCallMPI(MPI_Pack(X,ldnd,MPIU_SCALAR,ds->work,size,&off,PetscObjectComm((PetscObject)ds)));
    268:       PetscCallMPI(MPI_Pack(Y,ldnd,MPIU_SCALAR,ds->work,size,&off,PetscObjectComm((PetscObject)ds)));
    269:     }
    270:     if (eigr) PetscCallMPI(MPI_Pack(eigr,dn,MPIU_SCALAR,ds->work,size,&off,PetscObjectComm((PetscObject)ds)));
    271: #if !defined(PETSC_USE_COMPLEX)
    272:     if (eigi) PetscCallMPI(MPI_Pack(eigi,dn,MPIU_SCALAR,ds->work,size,&off,PetscObjectComm((PetscObject)ds)));
    273: #endif
    274:   }
    275:   PetscCallMPI(MPI_Bcast(ds->work,size,MPI_BYTE,0,PetscObjectComm((PetscObject)ds)));
    276:   if (rank) {
    277:     if (ds->state>=DS_STATE_CONDENSED) {
    278:       PetscCallMPI(MPI_Unpack(ds->work,size,&off,X,ldnd,MPIU_SCALAR,PetscObjectComm((PetscObject)ds)));
    279:       PetscCallMPI(MPI_Unpack(ds->work,size,&off,Y,ldnd,MPIU_SCALAR,PetscObjectComm((PetscObject)ds)));
    280:     }
    281:     if (eigr) PetscCallMPI(MPI_Unpack(ds->work,size,&off,eigr,dn,MPIU_SCALAR,PetscObjectComm((PetscObject)ds)));
    282: #if !defined(PETSC_USE_COMPLEX)
    283:     if (eigi) PetscCallMPI(MPI_Unpack(ds->work,size,&off,eigi,dn,MPIU_SCALAR,PetscObjectComm((PetscObject)ds)));
    284: #endif
    285:   }
    286:   if (ds->state>=DS_STATE_CONDENSED) {
    287:     PetscCall(MatDenseRestoreArray(ds->omat[DS_MAT_X],&X));
    288:     PetscCall(MatDenseRestoreArray(ds->omat[DS_MAT_Y],&Y));
    289:   }
    290:   PetscFunctionReturn(PETSC_SUCCESS);
    291: }
    292: #endif

    294: static PetscErrorCode DSPEPSetDegree_PEP(DS ds,PetscInt d)
    295: {
    296:   DS_PEP *ctx = (DS_PEP*)ds->data;

    298:   PetscFunctionBegin;
    299:   PetscCheck(d>=0,PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_OUTOFRANGE,"The degree must be a non-negative integer");
    300:   PetscCheck(d<DS_NUM_EXTRA,PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_OUTOFRANGE,"Only implemented for polynomials of degree at most %d",DS_NUM_EXTRA-1);
    301:   ctx->d = d;
    302:   PetscFunctionReturn(PETSC_SUCCESS);
    303: }

    305: /*@
    306:    DSPEPSetDegree - Sets the polynomial degree for a `DSPEP`.

    308:    Logically Collective

    310:    Input Parameters:
    311: +  ds - the direct solver context
    312: -  d  - the degree

    314:    Level: intermediate

    316: .seealso: [](sec:ds), `DSPEP`, `DSPEPGetDegree()`
    317: @*/
    318: PetscErrorCode DSPEPSetDegree(DS ds,PetscInt d)
    319: {
    320:   PetscFunctionBegin;
    323:   PetscTryMethod(ds,"DSPEPSetDegree_C",(DS,PetscInt),(ds,d));
    324:   PetscFunctionReturn(PETSC_SUCCESS);
    325: }

    327: static PetscErrorCode DSPEPGetDegree_PEP(DS ds,PetscInt *d)
    328: {
    329:   DS_PEP *ctx = (DS_PEP*)ds->data;

    331:   PetscFunctionBegin;
    332:   *d = ctx->d;
    333:   PetscFunctionReturn(PETSC_SUCCESS);
    334: }

    336: /*@
    337:    DSPEPGetDegree - Returns the polynomial degree for a `DSPEP`.

    339:    Not Collective

    341:    Input Parameter:
    342: .  ds - the direct solver context

    344:    Output Parameter:
    345: .  d - the degree

    347:    Level: intermediate

    349: .seealso: [](sec:ds), `DSPEP`, `DSPEPSetDegree()`
    350: @*/
    351: PetscErrorCode DSPEPGetDegree(DS ds,PetscInt *d)
    352: {
    353:   PetscFunctionBegin;
    355:   PetscAssertPointer(d,2);
    356:   PetscUseMethod(ds,"DSPEPGetDegree_C",(DS,PetscInt*),(ds,d));
    357:   PetscFunctionReturn(PETSC_SUCCESS);
    358: }

    360: static PetscErrorCode DSPEPSetCoefficients_PEP(DS ds,PetscReal *pbc)
    361: {
    362:   DS_PEP         *ctx = (DS_PEP*)ds->data;
    363:   PetscInt       i;

    365:   PetscFunctionBegin;
    366:   PetscCheck(ctx->d,PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_WRONGSTATE,"Must first specify the polynomial degree via DSPEPSetDegree()");
    367:   if (ctx->pbc) PetscCall(PetscFree(ctx->pbc));
    368:   PetscCall(PetscMalloc1(3*(ctx->d+1),&ctx->pbc));
    369:   for (i=0;i<3*(ctx->d+1);i++) ctx->pbc[i] = pbc[i];
    370:   ds->state = DS_STATE_RAW;
    371:   PetscFunctionReturn(PETSC_SUCCESS);
    372: }

    374: /*@
    375:    DSPEPSetCoefficients - Sets the polynomial basis coefficients for a `DSPEP`.

    377:    Logically Collective

    379:    Input Parameters:
    380: +  ds  - the direct solver context
    381: -  pbc - the polynomial basis coefficients

    383:    Notes:
    384:    This function is required only in the case of a polynomial specified in a
    385:    non-monomial basis, to provide the coefficients that will be used
    386:    during the linearization, multiplying the identity blocks on the three main
    387:    diagonal blocks. Depending on the polynomial basis (Chebyshev, Legendre, ...)
    388:    the coefficients must be different.

    390:    There must be a total of $3(d+1)$ coefficients, where $d$ is the degree of the
    391:    polynomial. The coefficients are arranged in three groups, $\alpha_i$, $\beta_i$, and
    392:    $\gamma_i$, according to the definition of the three-term recurrence. In the case
    393:    of the monomial basis, $\alpha_i=1$ and $\beta_i=\gamma_i=0$, in which case it is not
    394:    necessary to invoke this function.

    396:    Level: advanced

    398: .seealso: [](sec:ds), `DSPEP`, `DSPEPGetCoefficients()`, `DSPEPSetDegree()`
    399: @*/
    400: PetscErrorCode DSPEPSetCoefficients(DS ds,PetscReal pbc[])
    401: {
    402:   PetscFunctionBegin;
    404:   PetscAssertPointer(pbc,2);
    405:   PetscTryMethod(ds,"DSPEPSetCoefficients_C",(DS,PetscReal*),(ds,pbc));
    406:   PetscFunctionReturn(PETSC_SUCCESS);
    407: }

    409: static PetscErrorCode DSPEPGetCoefficients_PEP(DS ds,PetscReal *pbc[])
    410: {
    411:   DS_PEP         *ctx = (DS_PEP*)ds->data;
    412:   PetscInt       i;

    414:   PetscFunctionBegin;
    415:   PetscCheck(ctx->d,PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_WRONGSTATE,"Must first specify the polynomial degree via DSPEPSetDegree()");
    416:   PetscCall(PetscCalloc1(3*(ctx->d+1),pbc));
    417:   if (ctx->pbc) for (i=0;i<3*(ctx->d+1);i++) (*pbc)[i] = ctx->pbc[i];
    418:   else for (i=0;i<ctx->d+1;i++) (*pbc)[i] = 1.0;
    419:   PetscFunctionReturn(PETSC_SUCCESS);
    420: }

    422: /*@C
    423:    DSPEPGetCoefficients - Returns the polynomial basis coefficients for a `DSPEP`.

    425:    Not Collective

    427:    Input Parameter:
    428: .  ds - the direct solver context

    430:    Output Parameter:
    431: .  pbc - the polynomial basis coefficients

    433:    Note:
    434:    The returned array has length $3(d+1)$, where $d$ is the degree of the
    435:    polynomial, and should be freed by the user.

    437:    Fortran Notes:
    438:    In Fortran the user must provide in argument `pbc` a sufficiently large array.

    440:    Level: advanced

    442: .seealso: [](sec:ds), `DSPEP`, `DSPEPSetCoefficients()`
    443: @*/
    444: PetscErrorCode DSPEPGetCoefficients(DS ds,PetscReal *pbc[]) PeNS
    445: {
    446:   PetscFunctionBegin;
    448:   PetscAssertPointer(pbc,2);
    449:   PetscUseMethod(ds,"DSPEPGetCoefficients_C",(DS,PetscReal**),(ds,pbc));
    450:   PetscFunctionReturn(PETSC_SUCCESS);
    451: }

    453: static PetscErrorCode DSDestroy_PEP(DS ds)
    454: {
    455:   DS_PEP         *ctx = (DS_PEP*)ds->data;

    457:   PetscFunctionBegin;
    458:   if (ctx->pbc) PetscCall(PetscFree(ctx->pbc));
    459:   PetscCall(PetscFree(ds->data));
    460:   PetscCall(PetscObjectComposeFunction((PetscObject)ds,"DSPEPSetDegree_C",NULL));
    461:   PetscCall(PetscObjectComposeFunction((PetscObject)ds,"DSPEPGetDegree_C",NULL));
    462:   PetscCall(PetscObjectComposeFunction((PetscObject)ds,"DSPEPSetCoefficients_C",NULL));
    463:   PetscCall(PetscObjectComposeFunction((PetscObject)ds,"DSPEPGetCoefficients_C",NULL));
    464:   PetscFunctionReturn(PETSC_SUCCESS);
    465: }

    467: static PetscErrorCode DSMatGetSize_PEP(DS ds,DSMatType t,PetscInt *rows,PetscInt *cols)
    468: {
    469:   DS_PEP *ctx = (DS_PEP*)ds->data;

    471:   PetscFunctionBegin;
    472:   PetscCheck(ctx->d,PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_WRONGSTATE,"DSPEP requires specifying the polynomial degree via DSPEPSetDegree()");
    473:   *rows = ds->n;
    474:   if (t==DS_MAT_A || t==DS_MAT_B || t==DS_MAT_W || t==DS_MAT_U) *rows *= ctx->d;
    475:   *cols = ds->n;
    476:   if (t==DS_MAT_A || t==DS_MAT_B || t==DS_MAT_W || t==DS_MAT_U || t==DS_MAT_X || t==DS_MAT_Y) *cols *= ctx->d;
    477:   PetscFunctionReturn(PETSC_SUCCESS);
    478: }

    480: /*MC
    481:    DSPEP - Dense Polynomial Eigenvalue Problem.

    483:    Notes:
    484:    The problem is expressed as $P(\lambda)x = 0$, where $P(\cdot)$ is a
    485:    polynomial matrix of degree $d$. The eigenvalues $\lambda$ are the arguments
    486:    returned by `DSSolve()`.

    488:    The degree of the polynomial, $d$, can be set with `DSPEPSetDegree()`, with
    489:    the first $d+1$ extra matrices of the `DS` storing the polynomial coefficient.
    490:    By default, the polynomial is expressed in the monomial basis, but a
    491:    different basis can be used by setting the corresponding coefficients
    492:    via `DSPEPSetCoefficients()`.

    494:    The problem is solved via linearization, by building a pencil $(A,B)$ of
    495:    size $d\cdot n$ and solving the corresponding `GNHEP`.

    497:    Used DS matrices:
    498: +  `DS_MAT_E0` to `DS_MAT_E9` - coefficients of the matrix polynomial
    499: .  `DS_MAT_X`  - right eigenvectors
    500: .  `DS_MAT_Y`  - left eigenvectors
    501: .  `DS_MAT_A`  - (workspace) first matrix of the linearization
    502: .  `DS_MAT_B`  - (workspace) second matrix of the linearization
    503: .  `DS_MAT_W`  - (workspace) right eigenvectors of the linearization
    504: -  `DS_MAT_U`  - (workspace) left eigenvectors of the linearization

    506:    Implemented methods:
    507: .  0 - QZ iteration on the linearization (`_ggev`)

    509:    Level: beginner

    511: .seealso: [](sec:ds), `DSCreate()`, `DSSetType()`, `DSType`, `DSPEPSetDegree()`, `DSPEPSetCoefficients()`
    512: M*/
    513: SLEPC_EXTERN PetscErrorCode DSCreate_PEP(DS ds)
    514: {
    515:   DS_PEP         *ctx;

    517:   PetscFunctionBegin;
    518:   PetscCall(PetscNew(&ctx));
    519:   ds->data = (void*)ctx;

    521:   ds->ops->allocate      = DSAllocate_PEP;
    522:   ds->ops->view          = DSView_PEP;
    523:   ds->ops->vectors       = DSVectors_PEP;
    524:   ds->ops->solve[0]      = DSSolve_PEP_QZ;
    525: #if !defined(SLEPC_MISSING_LAPACK_GGES3)
    526:   ds->ops->solve[1]      = DSSolve_PEP_QZ;
    527: #endif
    528:   ds->ops->sort          = DSSort_PEP;
    529: #if !defined(PETSC_HAVE_MPIUNI)
    530:   ds->ops->synchronize   = DSSynchronize_PEP;
    531: #endif
    532:   ds->ops->destroy       = DSDestroy_PEP;
    533:   ds->ops->matgetsize    = DSMatGetSize_PEP;
    534:   PetscCall(PetscObjectComposeFunction((PetscObject)ds,"DSPEPSetDegree_C",DSPEPSetDegree_PEP));
    535:   PetscCall(PetscObjectComposeFunction((PetscObject)ds,"DSPEPGetDegree_C",DSPEPGetDegree_PEP));
    536:   PetscCall(PetscObjectComposeFunction((PetscObject)ds,"DSPEPSetCoefficients_C",DSPEPSetCoefficients_PEP));
    537:   PetscCall(PetscObjectComposeFunction((PetscObject)ds,"DSPEPGetCoefficients_C",DSPEPGetCoefficients_PEP));
    538:   PetscFunctionReturn(PETSC_SUCCESS);
    539: }