Actual source code: nrefine.c

slepc-3.19.0 2023-03-31
Report Typos and Errors
  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:    Newton refinement for polynomial eigenproblems.

 13:    References:

 15:        [1] T. Betcke and D. Kressner, "Perturbation, extraction and refinement
 16:            of invariant pairs for matrix polynomials", Linear Algebra Appl.
 17:            435(3):514-536, 2011.

 19:        [2] C. Campos and J.E. Roman, "Parallel iterative refinement in
 20:            polynomial eigenvalue problems", Numer. Linear Algebra Appl. 23(4):
 21:            730-745, 2016.
 22: */

 24: #include <slepc/private/pepimpl.h>
 25: #include <slepcblaslapack.h>

 27: typedef struct {
 28:   Mat          *A,M1;
 29:   BV           V,M2,M3,W;
 30:   PetscInt     k,nmat;
 31:   PetscScalar  *fih,*work,*M4;
 32:   PetscBLASInt *pM4;
 33:   PetscBool    compM1;
 34:   Vec          t;
 35: } PEP_REFINE_MATSHELL;

 37: typedef struct {
 38:   Mat          E[2],M1;
 39:   Vec          tN,ttN,t1,vseq;
 40:   VecScatter   scatterctx;
 41:   PetscBool    compM1;
 42:   PetscInt     *map0,*map1,*idxg,*idxp;
 43:   PetscSubcomm subc;
 44:   VecScatter   scatter_sub;
 45:   VecScatter   *scatter_id,*scatterp_id;
 46:   Mat          *A;
 47:   BV           V,W,M2,M3,Wt;
 48:   PetscScalar  *M4,*w,*wt,*d,*dt;
 49:   Vec          t,tg,Rv,Vi,tp,tpg;
 50:   PetscInt     idx,*cols;
 51: } PEP_REFINE_EXPLICIT;

 53: static PetscErrorCode MatMult_FS(Mat M ,Vec x,Vec y)
 54: {
 55:   PEP_REFINE_MATSHELL *ctx;
 56:   PetscInt            k,i;
 57:   PetscScalar         *c;
 58:   PetscBLASInt        k_,one=1,info;

 60:   PetscFunctionBegin;
 61:   PetscCall(MatShellGetContext(M,&ctx));
 62:   PetscCall(VecCopy(x,ctx->t));
 63:   k    = ctx->k;
 64:   c    = ctx->work;
 65:   PetscCall(PetscBLASIntCast(k,&k_));
 66:   PetscCall(MatMult(ctx->M1,x,y));
 67:   PetscCall(VecConjugate(ctx->t));
 68:   PetscCall(BVDotVec(ctx->M3,ctx->t,c));
 69:   for (i=0;i<k;i++) c[i] = PetscConj(c[i]);
 70:   PetscCall(PetscFPTrapPush(PETSC_FP_TRAP_OFF));
 71:   PetscCallBLAS("LAPACKgetrs",LAPACKgetrs_("N",&k_,&one,ctx->M4,&k_,ctx->pM4,c,&k_,&info));
 72:   PetscCall(PetscFPTrapPop());
 73:   SlepcCheckLapackInfo("getrs",info);
 74:   PetscCall(BVMultVec(ctx->M2,-1.0,1.0,y,c));
 75:   PetscFunctionReturn(PETSC_SUCCESS);
 76: }

 78: /*
 79:   Evaluates the first d elements of the polynomial basis
 80:   on a given matrix H which is considered to be triangular
 81: */
 82: static PetscErrorCode PEPEvaluateBasisforMatrix(PEP pep,PetscInt nm,PetscInt k,PetscScalar *H,PetscInt ldh,PetscScalar *fH)
 83: {
 84:   PetscInt       i,j,ldfh=nm*k,off,nmat=pep->nmat;
 85:   PetscReal      *a=pep->pbc,*b=pep->pbc+nmat,*g=pep->pbc+2*nmat,t;
 86:   PetscScalar    corr=0.0,alpha,beta;
 87:   PetscBLASInt   k_,ldh_,ldfh_;

 89:   PetscFunctionBegin;
 90:   PetscCall(PetscBLASIntCast(ldh,&ldh_));
 91:   PetscCall(PetscBLASIntCast(k,&k_));
 92:   PetscCall(PetscBLASIntCast(ldfh,&ldfh_));
 93:   PetscCall(PetscArrayzero(fH,nm*k*k));
 94:   if (nm>0) for (j=0;j<k;j++) fH[j+j*ldfh] = 1.0;
 95:   if (nm>1) {
 96:     t = b[0]/a[0];
 97:     off = k;
 98:     for (j=0;j<k;j++) {
 99:       for (i=0;i<k;i++) fH[off+i+j*ldfh] = H[i+j*ldh]/a[0];
100:       fH[j+j*ldfh] -= t;
101:     }
102:   }
103:   for (i=2;i<nm;i++) {
104:     off = i*k;
105:     if (i==2) {
106:       for (j=0;j<k;j++) {
107:         fH[off+j+j*ldfh] = 1.0;
108:         H[j+j*ldh] -= b[1];
109:       }
110:     } else {
111:       for (j=0;j<k;j++) {
112:         PetscCall(PetscArraycpy(fH+off+j*ldfh,fH+(i-2)*k+j*ldfh,k));
113:         H[j+j*ldh] += corr-b[i-1];
114:       }
115:     }
116:     corr  = b[i-1];
117:     beta  = -g[i-1]/a[i-1];
118:     alpha = 1/a[i-1];
119:     PetscCallBLAS("BLASgemm",BLASgemm_("N","N",&k_,&k_,&k_,&alpha,H,&ldh_,fH+(i-1)*k,&ldfh_,&beta,fH+off,&ldfh_));
120:   }
121:   for (j=0;j<k;j++) H[j+j*ldh] += corr;
122:   PetscFunctionReturn(PETSC_SUCCESS);
123: }

125: static PetscErrorCode NRefSysSetup_shell(PEP pep,PetscInt k,PetscScalar *fH,PetscScalar *S,PetscInt lds,PetscScalar *fh,PetscScalar h,PEP_REFINE_MATSHELL *ctx)
126: {
127:   PetscScalar       *DHii,*T12,*Tr,*Ts,*array,s,ss,sone=1.0,zero=0.0,*M4=ctx->M4,t,*v,*T;
128:   const PetscScalar *m3,*m2;
129:   PetscInt          i,d,j,nmat=pep->nmat,lda=nmat*k,deg=nmat-1,nloc;
130:   PetscReal         *a=pep->pbc,*b=pep->pbc+nmat,*g=pep->pbc+2*nmat;
131:   PetscBLASInt      k_,lda_,lds_,nloc_,one=1,info;
132:   Mat               *A=ctx->A,Mk,M1=ctx->M1,P;
133:   BV                V=ctx->V,M2=ctx->M2,M3=ctx->M3,W=ctx->W;
134:   MatStructure      str;
135:   Vec               vc;

137:   PetscFunctionBegin;
138:   PetscCall(STGetMatStructure(pep->st,&str));
139:   PetscCall(PetscMalloc3(nmat*k*k,&T12,k*k,&Tr,PetscMax(k*k,nmat),&Ts));
140:   DHii = T12;
141:   PetscCall(PetscArrayzero(DHii,k*k*nmat));
142:   for (i=0;i<k;i++) DHii[k+i+i*lda] = 1.0/a[0];
143:   for (d=2;d<nmat;d++) {
144:     for (j=0;j<k;j++) {
145:       for (i=0;i<k;i++) {
146:         DHii[d*k+i+j*lda] = ((h-b[d-1])*DHii[(d-1)*k+i+j*lda]+fH[(d-1)*k+i+j*lda]-g[d-1]*DHii[(d-2)*k+i+j*lda])/(a[d-1]);
147:       }
148:     }
149:   }
150:   /* T11 */
151:   if (!ctx->compM1) {
152:     PetscCall(MatCopy(A[0],M1,DIFFERENT_NONZERO_PATTERN));
153:     PetscCall(PEPEvaluateBasis(pep,h,0,Ts,NULL));
154:     for (j=1;j<nmat;j++) PetscCall(MatAXPY(M1,Ts[j],A[j],str));
155:   }

157:   /* T22 */
158:   PetscCall(PetscBLASIntCast(lds,&lds_));
159:   PetscCall(PetscBLASIntCast(k,&k_));
160:   PetscCall(PetscBLASIntCast(lda,&lda_));
161:   PetscCallBLAS("BLASgemm",BLASgemm_("C","N",&k_,&k_,&k_,&sone,S,&lds_,S,&lds_,&zero,Tr,&k_));
162:   for (i=1;i<deg;i++) {
163:     PetscCallBLAS("BLASgemm",BLASgemm_("N","N",&k_,&k_,&k_,&sone,Tr,&k_,DHii+i*k,&lda_,&zero,Ts,&k_));
164:     s = (i==1)?0.0:1.0;
165:     PetscCallBLAS("BLASgemm",BLASgemm_("C","N",&k_,&k_,&k_,&sone,fH+i*k,&lda_,Ts,&k_,&s,M4,&k_));
166:   }
167:   for (i=0;i<k;i++) for (j=0;j<i;j++) { t=M4[i+j*k];M4[i+j*k]=M4[j+i*k];M4[j+i*k]=t; }

169:   /* T12 */
170:   PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,k,k,NULL,&Mk));
171:   for (i=1;i<nmat;i++) {
172:     PetscCall(MatDenseGetArrayWrite(Mk,&array));
173:     PetscCallBLAS("BLASgemm",BLASgemm_("N","N",&k_,&k_,&k_,&sone,S,&lds_,DHii+i*k,&lda_,&zero,array,&k_));
174:     PetscCall(MatDenseRestoreArrayWrite(Mk,&array));
175:     PetscCall(BVSetActiveColumns(W,0,k));
176:     PetscCall(BVMult(W,1.0,0.0,V,Mk));
177:     if (i==1) PetscCall(BVMatMult(W,A[i],M2));
178:     else {
179:       PetscCall(BVMatMult(W,A[i],M3)); /* using M3 as work space */
180:       PetscCall(BVMult(M2,1.0,1.0,M3,NULL));
181:     }
182:   }

184:   /* T21 */
185:   PetscCall(MatDenseGetArrayWrite(Mk,&array));
186:   for (i=1;i<deg;i++) {
187:     s = (i==1)?0.0:1.0;
188:     ss = PetscConj(fh[i]);
189:     PetscCallBLAS("BLASgemm",BLASgemm_("N","N",&k_,&k_,&k_,&ss,S,&lds_,fH+i*k,&lda_,&s,array,&k_));
190:   }
191:   PetscCall(MatDenseRestoreArrayWrite(Mk,&array));
192:   PetscCall(BVSetActiveColumns(M3,0,k));
193:   PetscCall(BVMult(M3,1.0,0.0,V,Mk));
194:   for (i=0;i<k;i++) {
195:     PetscCall(BVGetColumn(M3,i,&vc));
196:     PetscCall(VecConjugate(vc));
197:     PetscCall(BVRestoreColumn(M3,i,&vc));
198:   }
199:   PetscCall(MatDestroy(&Mk));
200:   PetscCall(PetscFree3(T12,Tr,Ts));

202:   PetscCall(VecGetLocalSize(ctx->t,&nloc));
203:   PetscCall(PetscBLASIntCast(nloc,&nloc_));
204:   PetscCall(PetscMalloc1(nloc*k,&T));
205:   PetscCall(KSPGetOperators(pep->refineksp,NULL,&P));
206:   if (!ctx->compM1) PetscCall(MatCopy(ctx->M1,P,SAME_NONZERO_PATTERN));
207:   PetscCall(BVGetArrayRead(ctx->M2,&m2));
208:   PetscCall(BVGetArrayRead(ctx->M3,&m3));
209:   PetscCall(VecGetArray(ctx->t,&v));
210:   for (i=0;i<nloc;i++) for (j=0;j<k;j++) T[j+i*k] = m3[i+j*nloc];
211:   PetscCall(PetscFPTrapPush(PETSC_FP_TRAP_OFF));
212:   PetscCallBLAS("LAPACKgesv",LAPACKgesv_(&k_,&nloc_,ctx->M4,&k_,ctx->pM4,T,&k_,&info));
213:   PetscCall(PetscFPTrapPop());
214:   SlepcCheckLapackInfo("gesv",info);
215:   for (i=0;i<nloc;i++) v[i] = BLASdot_(&k_,m2+i,&nloc_,T+i*k,&one);
216:   PetscCall(VecRestoreArray(ctx->t,&v));
217:   PetscCall(BVRestoreArrayRead(ctx->M2,&m2));
218:   PetscCall(BVRestoreArrayRead(ctx->M3,&m3));
219:   PetscCall(MatDiagonalSet(P,ctx->t,ADD_VALUES));
220:   PetscCall(PetscFree(T));
221:   PetscCall(KSPSetUp(pep->refineksp));
222:   PetscFunctionReturn(PETSC_SUCCESS);
223: }

225: static PetscErrorCode NRefSysSolve_shell(KSP ksp,PetscInt nmat,Vec Rv,PetscScalar *Rh,PetscInt k,Vec dVi,PetscScalar *dHi)
226: {
227:   PetscScalar         *t0;
228:   PetscBLASInt        k_,one=1,info,lda_;
229:   PetscInt            i,lda=nmat*k;
230:   Mat                 M;
231:   PEP_REFINE_MATSHELL *ctx;

233:   PetscFunctionBegin;
234:   PetscCall(KSPGetOperators(ksp,&M,NULL));
235:   PetscCall(MatShellGetContext(M,&ctx));
236:   PetscCall(PetscCalloc1(k,&t0));
237:   PetscCall(PetscFPTrapPush(PETSC_FP_TRAP_OFF));
238:   PetscCall(PetscBLASIntCast(lda,&lda_));
239:   PetscCall(PetscBLASIntCast(k,&k_));
240:   for (i=0;i<k;i++) t0[i] = Rh[i];
241:   PetscCallBLAS("LAPACKgetrs",LAPACKgetrs_("N",&k_,&one,ctx->M4,&k_,ctx->pM4,t0,&k_,&info));
242:   SlepcCheckLapackInfo("getrs",info);
243:   PetscCall(BVMultVec(ctx->M2,-1.0,1.0,Rv,t0));
244:   PetscCall(KSPSolve(ksp,Rv,dVi));
245:   PetscCall(VecConjugate(dVi));
246:   PetscCall(BVDotVec(ctx->M3,dVi,dHi));
247:   PetscCall(VecConjugate(dVi));
248:   for (i=0;i<k;i++) dHi[i] = Rh[i]-PetscConj(dHi[i]);
249:   PetscCallBLAS("LAPACKgetrs",LAPACKgetrs_("N",&k_,&one,ctx->M4,&k_,ctx->pM4,dHi,&k_,&info));
250:   SlepcCheckLapackInfo("getrs",info);
251:   PetscCall(PetscFPTrapPop());
252:   PetscCall(PetscFree(t0));
253:   PetscFunctionReturn(PETSC_SUCCESS);
254: }

256: /*
257:    Computes the residual P(H,V*S)*e_j for the polynomial
258: */
259: static PetscErrorCode NRefRightSide(PetscInt nmat,PetscReal *pcf,Mat *A,PetscInt k,BV V,PetscScalar *S,PetscInt lds,PetscInt j,PetscScalar *H,PetscInt ldh,PetscScalar *fH,PetscScalar *DfH,PetscScalar *dH,BV dV,PetscScalar *dVS,PetscInt rds,Vec Rv,PetscScalar *Rh,BV W,Vec t)
260: {
261:   PetscScalar    *DS0,*DS1,*F,beta=0.0,sone=1.0,none=-1.0,tt=0.0,*h,zero=0.0,*Z,*c0;
262:   PetscReal      *a=pcf,*b=pcf+nmat,*g=b+nmat;
263:   PetscInt       i,ii,jj,lda;
264:   PetscBLASInt   lda_,k_,ldh_,lds_,nmat_,k2_,krds_,j_,one=1;
265:   Mat            M0;
266:   Vec            w;

268:   PetscFunctionBegin;
269:   PetscCall(PetscMalloc4(k*nmat,&h,k*k,&DS0,k*k,&DS1,k*k,&Z));
270:   lda = k*nmat;
271:   PetscCall(PetscBLASIntCast(k,&k_));
272:   PetscCall(PetscBLASIntCast(lds,&lds_));
273:   PetscCall(PetscBLASIntCast(lda,&lda_));
274:   PetscCall(PetscBLASIntCast(nmat,&nmat_));
275:   PetscCallBLAS("BLASgemm",BLASgemm_("N","N",&k_,&nmat_,&k_,&sone,S,&lds_,fH+j*lda,&k_,&zero,h,&k_));
276:   PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,k,nmat,h,&M0));
277:   PetscCall(BVSetActiveColumns(W,0,nmat));
278:   PetscCall(BVMult(W,1.0,0.0,V,M0));
279:   PetscCall(MatDestroy(&M0));

281:   PetscCall(BVGetColumn(W,0,&w));
282:   PetscCall(MatMult(A[0],w,Rv));
283:   PetscCall(BVRestoreColumn(W,0,&w));
284:   for (i=1;i<nmat;i++) {
285:     PetscCall(BVGetColumn(W,i,&w));
286:     PetscCall(MatMult(A[i],w,t));
287:     PetscCall(BVRestoreColumn(W,i,&w));
288:     PetscCall(VecAXPY(Rv,1.0,t));
289:   }
290:   /* Update right-hand side */
291:   if (j) {
292:     PetscCall(PetscBLASIntCast(ldh,&ldh_));
293:     PetscCall(PetscArrayzero(Z,k*k));
294:     PetscCall(PetscArrayzero(DS0,k*k));
295:     PetscCall(PetscArraycpy(Z+(j-1)*k,dH+(j-1)*k,k));
296:     /* Update DfH */
297:     for (i=1;i<nmat;i++) {
298:       if (i>1) {
299:         beta = -g[i-1];
300:         PetscCallBLAS("BLASgemm",BLASgemm_("N","N",&k_,&k_,&k_,&sone,fH+(i-1)*k,&lda_,Z,&k_,&beta,DS0,&k_));
301:         tt += -b[i-1];
302:         for (ii=0;ii<k;ii++) H[ii+ii*ldh] += tt;
303:         tt = b[i-1];
304:         beta = 1.0/a[i-1];
305:         PetscCallBLAS("BLASgemm",BLASgemm_("N","N",&k_,&k_,&k_,&beta,DS1,&k_,H,&ldh_,&beta,DS0,&k_));
306:         F = DS0; DS0 = DS1; DS1 = F;
307:       } else {
308:         PetscCall(PetscArrayzero(DS1,k*k));
309:         for (ii=0;ii<k;ii++) DS1[ii+(j-1)*k] = Z[ii+(j-1)*k]/a[0];
310:       }
311:       for (jj=j;jj<k;jj++) {
312:         for (ii=0;ii<k;ii++) DfH[k*i+ii+jj*lda] += DS1[ii+jj*k];
313:       }
314:     }
315:     for (ii=0;ii<k;ii++) H[ii+ii*ldh] += tt;
316:     /* Update right-hand side */
317:     PetscCall(PetscBLASIntCast(2*k,&k2_));
318:     PetscCall(PetscBLASIntCast(j,&j_));
319:     PetscCall(PetscBLASIntCast(k+rds,&krds_));
320:     c0 = DS0;
321:     PetscCall(PetscArrayzero(Rh,k));
322:     for (i=0;i<nmat;i++) {
323:       PetscCallBLAS("BLASgemv",BLASgemv_("N",&krds_,&j_,&sone,dVS,&k2_,fH+j*lda+i*k,&one,&zero,h,&one));
324:       PetscCallBLAS("BLASgemv",BLASgemv_("N",&k_,&k_,&sone,S,&lds_,DfH+i*k+j*lda,&one,&sone,h,&one));
325:       PetscCall(BVMultVec(V,1.0,0.0,t,h));
326:       PetscCall(BVSetActiveColumns(dV,0,rds));
327:       PetscCall(BVMultVec(dV,1.0,1.0,t,h+k));
328:       PetscCall(BVGetColumn(W,i,&w));
329:       PetscCall(MatMult(A[i],t,w));
330:       PetscCall(BVRestoreColumn(W,i,&w));
331:       if (i>0 && i<nmat-1) {
332:         PetscCallBLAS("BLASgemv",BLASgemv_("C",&k_,&k_,&sone,S,&lds_,h,&one,&zero,c0,&one));
333:         PetscCallBLAS("BLASgemv",BLASgemv_("C",&k_,&k_,&none,fH+i*k,&lda_,c0,&one,&sone,Rh,&one));
334:       }
335:     }

337:     for (i=0;i<nmat;i++) h[i] = -1.0;
338:     PetscCall(BVMultVec(W,1.0,1.0,Rv,h));
339:   }
340:   PetscCall(PetscFree4(h,DS0,DS1,Z));
341:   PetscFunctionReturn(PETSC_SUCCESS);
342: }

344: static PetscErrorCode NRefSysSolve_mbe(PetscInt k,PetscInt sz,BV W,PetscScalar *w,BV Wt,PetscScalar *wt,PetscScalar *d,PetscScalar *dt,KSP ksp,BV T2,BV T3 ,PetscScalar *T4,PetscBool trans,Vec x1,PetscScalar *x2,Vec sol1,PetscScalar *sol2,Vec vw)
345: {
346:   PetscInt       i,j,incf,incc;
347:   PetscScalar    *y,*g,*xx2,*ww,y2,*dd;
348:   Vec            v,t,xx1;
349:   BV             WW,T;

351:   PetscFunctionBegin;
352:   PetscCall(PetscMalloc3(sz,&y,sz,&g,k,&xx2));
353:   if (trans) {
354:     WW = W; ww = w; dd = d; T = T3; incf = 0; incc = 1;
355:   } else {
356:     WW = Wt; ww = wt; dd = dt; T = T2; incf = 1; incc = 0;
357:   }
358:   xx1 = vw;
359:   PetscCall(VecCopy(x1,xx1));
360:   PetscCall(PetscArraycpy(xx2,x2,sz));
361:   PetscCall(PetscArrayzero(sol2,k));
362:   for (i=sz-1;i>=0;i--) {
363:     PetscCall(BVGetColumn(WW,i,&v));
364:     PetscCall(VecConjugate(v));
365:     PetscCall(VecDot(xx1,v,y+i));
366:     PetscCall(VecConjugate(v));
367:     PetscCall(BVRestoreColumn(WW,i,&v));
368:     for (j=0;j<i;j++) y[i] += ww[j+i*k]*xx2[j];
369:     y[i] = -(y[i]-xx2[i])/dd[i];
370:     PetscCall(BVGetColumn(T,i,&t));
371:     PetscCall(VecAXPY(xx1,-y[i],t));
372:     PetscCall(BVRestoreColumn(T,i,&t));
373:     for (j=0;j<=i;j++) xx2[j] -= y[i]*T4[j*incf+incc*i+(i*incf+incc*j)*k];
374:     g[i] = xx2[i];
375:   }
376:   if (trans) PetscCall(KSPSolveTranspose(ksp,xx1,sol1));
377:   else PetscCall(KSPSolve(ksp,xx1,sol1));
378:   if (trans) {
379:     WW = Wt; ww = wt; dd = dt; T = T2; incf = 1; incc = 0;
380:   } else {
381:     WW = W; ww = w; dd = d; T = T3; incf = 0; incc = 1;
382:   }
383:   for (i=0;i<sz;i++) {
384:     PetscCall(BVGetColumn(T,i,&t));
385:     PetscCall(VecConjugate(t));
386:     PetscCall(VecDot(sol1,t,&y2));
387:     PetscCall(VecConjugate(t));
388:     PetscCall(BVRestoreColumn(T,i,&t));
389:     for (j=0;j<i;j++) y2 += sol2[j]*T4[j*incf+incc*i+(i*incf+incc*j)*k];
390:     y2 = (g[i]-y2)/dd[i];
391:     PetscCall(BVGetColumn(WW,i,&v));
392:     PetscCall(VecAXPY(sol1,-y2,v));
393:     for (j=0;j<i;j++) sol2[j] -= ww[j+i*k]*y2;
394:     sol2[i] = y[i]+y2;
395:     PetscCall(BVRestoreColumn(WW,i,&v));
396:   }
397:   PetscCall(PetscFree3(y,g,xx2));
398:   PetscFunctionReturn(PETSC_SUCCESS);
399: }

401: static PetscErrorCode NRefSysSetup_mbe(PEP pep,PetscInt k,KSP ksp,PetscScalar *fH,PetscScalar *S,PetscInt lds,PetscScalar *fh,PetscScalar h,BV V,PEP_REFINE_EXPLICIT *matctx)
402: {
403:   PetscInt       i,j,l,nmat=pep->nmat,lda=nmat*k,deg=nmat-1;
404:   Mat            M1=matctx->M1,*A,*At,Mk;
405:   PetscReal      *a=pep->pbc,*b=pep->pbc+nmat,*g=pep->pbc+2*nmat;
406:   PetscScalar    s,ss,*DHii,*T12,*array,*Ts,*Tr,*M4=matctx->M4,sone=1.0,zero=0.0;
407:   PetscScalar    *w=matctx->w,*wt=matctx->wt,*d=matctx->d,*dt=matctx->dt;
408:   PetscBLASInt   lds_,lda_,k_;
409:   MatStructure   str;
410:   PetscBool      flg;
411:   BV             M2=matctx->M2,M3=matctx->M3,W=matctx->W,Wt=matctx->Wt;
412:   Vec            vc,vc2;

414:   PetscFunctionBegin;
415:   PetscCall(PetscMalloc3(nmat*k*k,&T12,k*k,&Tr,PetscMax(k*k,nmat),&Ts));
416:   PetscCall(STGetMatStructure(pep->st,&str));
417:   PetscCall(STGetTransform(pep->st,&flg));
418:   if (flg) {
419:     PetscCall(PetscMalloc1(pep->nmat,&At));
420:     for (i=0;i<pep->nmat;i++) PetscCall(STGetMatrixTransformed(pep->st,i,&At[i]));
421:   } else At = pep->A;
422:   if (matctx->subc) A = matctx->A;
423:   else A = At;
424:   /* Form the explicit system matrix */
425:   DHii = T12;
426:   PetscCall(PetscArrayzero(DHii,k*k*nmat));
427:   for (i=0;i<k;i++) DHii[k+i+i*lda] = 1.0/a[0];
428:   for (l=2;l<nmat;l++) {
429:     for (j=0;j<k;j++) {
430:       for (i=0;i<k;i++) {
431:         DHii[l*k+i+j*lda] = ((h-b[l-1])*DHii[(l-1)*k+i+j*lda]+fH[(l-1)*k+i+j*lda]-g[l-1]*DHii[(l-2)*k+i+j*lda])/a[l-1];
432:       }
433:     }
434:   }

436:   /* T11 */
437:   if (!matctx->compM1) {
438:     PetscCall(MatCopy(A[0],M1,DIFFERENT_NONZERO_PATTERN));
439:     PetscCall(PEPEvaluateBasis(pep,h,0,Ts,NULL));
440:     for (j=1;j<nmat;j++) PetscCall(MatAXPY(M1,Ts[j],A[j],str));
441:   }

443:   /* T22 */
444:   PetscCall(PetscBLASIntCast(lds,&lds_));
445:   PetscCall(PetscBLASIntCast(k,&k_));
446:   PetscCall(PetscBLASIntCast(lda,&lda_));
447:   PetscCallBLAS("BLASgemm",BLASgemm_("C","N",&k_,&k_,&k_,&sone,S,&lds_,S,&lds_,&zero,Tr,&k_));
448:   for (i=1;i<deg;i++) {
449:     PetscCallBLAS("BLASgemm",BLASgemm_("N","N",&k_,&k_,&k_,&sone,Tr,&k_,DHii+i*k,&lda_,&zero,Ts,&k_));
450:     s = (i==1)?0.0:1.0;
451:     PetscCallBLAS("BLASgemm",BLASgemm_("C","N",&k_,&k_,&k_,&sone,fH+i*k,&lda_,Ts,&k_,&s,M4,&k_));
452:   }

454:   /* T12 */
455:   PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,k,k,NULL,&Mk));
456:   for (i=1;i<nmat;i++) {
457:     PetscCall(MatDenseGetArrayWrite(Mk,&array));
458:     PetscCallBLAS("BLASgemm",BLASgemm_("N","N",&k_,&k_,&k_,&sone,S,&lds_,DHii+i*k,&lda_,&zero,array,&k_));
459:     PetscCall(MatDenseRestoreArrayWrite(Mk,&array));
460:     PetscCall(BVSetActiveColumns(W,0,k));
461:     PetscCall(BVMult(W,1.0,0.0,V,Mk));
462:     if (i==1) PetscCall(BVMatMult(W,A[i],M2));
463:     else {
464:       PetscCall(BVMatMult(W,A[i],M3)); /* using M3 as work space */
465:       PetscCall(BVMult(M2,1.0,1.0,M3,NULL));
466:     }
467:   }

469:   /* T21 */
470:   PetscCall(MatDenseGetArrayWrite(Mk,&array));
471:   for (i=1;i<deg;i++) {
472:     s = (i==1)?0.0:1.0;
473:     ss = PetscConj(fh[i]);
474:     PetscCallBLAS("BLASgemm",BLASgemm_("N","N",&k_,&k_,&k_,&ss,S,&lds_,fH+i*k,&lda_,&s,array,&k_));
475:   }
476:   PetscCall(MatDenseRestoreArrayWrite(Mk,&array));
477:   PetscCall(BVSetActiveColumns(M3,0,k));
478:   PetscCall(BVMult(M3,1.0,0.0,V,Mk));
479:   for (i=0;i<k;i++) {
480:     PetscCall(BVGetColumn(M3,i,&vc));
481:     PetscCall(VecConjugate(vc));
482:     PetscCall(BVRestoreColumn(M3,i,&vc));
483:   }

485:   PetscCall(PEP_KSPSetOperators(ksp,M1,M1));
486:   PetscCall(KSPSetUp(ksp));
487:   PetscCall(MatDestroy(&Mk));

489:   /* Set up for BEMW */
490:   for (i=0;i<k;i++) {
491:     PetscCall(BVGetColumn(M2,i,&vc));
492:     PetscCall(BVGetColumn(W,i,&vc2));
493:     PetscCall(NRefSysSolve_mbe(k,i,W,w,Wt,wt,d,dt,ksp,M2,M3,M4,PETSC_FALSE,vc,M4+i*k,vc2,w+i*k,matctx->t));
494:     PetscCall(BVRestoreColumn(M2,i,&vc));
495:     PetscCall(BVGetColumn(M3,i,&vc));
496:     PetscCall(VecConjugate(vc));
497:     PetscCall(VecDot(vc2,vc,&d[i]));
498:     PetscCall(VecConjugate(vc));
499:     PetscCall(BVRestoreColumn(M3,i,&vc));
500:     for (j=0;j<i;j++) d[i] += M4[i+j*k]*w[j+i*k];
501:     d[i] = M4[i+i*k]-d[i];
502:     PetscCall(BVRestoreColumn(W,i,&vc2));

504:     PetscCall(BVGetColumn(M3,i,&vc));
505:     PetscCall(BVGetColumn(Wt,i,&vc2));
506:     for (j=0;j<=i;j++) Ts[j] = M4[i+j*k];
507:     PetscCall(NRefSysSolve_mbe(k,i,W,w,Wt,wt,d,dt,ksp,M2,M3,M4,PETSC_TRUE,vc,Ts,vc2,wt+i*k,matctx->t));
508:     PetscCall(BVRestoreColumn(M3,i,&vc));
509:     PetscCall(BVGetColumn(M2,i,&vc));
510:     PetscCall(VecConjugate(vc2));
511:     PetscCall(VecDot(vc,vc2,&dt[i]));
512:     PetscCall(VecConjugate(vc2));
513:     PetscCall(BVRestoreColumn(M2,i,&vc));
514:     for (j=0;j<i;j++) dt[i] += M4[j+i*k]*wt[j+i*k];
515:     dt[i] = M4[i+i*k]-dt[i];
516:     PetscCall(BVRestoreColumn(Wt,i,&vc2));
517:   }

519:   if (flg) PetscCall(PetscFree(At));
520:   PetscCall(PetscFree3(T12,Tr,Ts));
521:   PetscFunctionReturn(PETSC_SUCCESS);
522: }

524: static PetscErrorCode NRefSysSetup_explicit(PEP pep,PetscInt k,KSP ksp,PetscScalar *fH,PetscScalar *S,PetscInt lds,PetscScalar *fh,PetscScalar h,BV V,PEP_REFINE_EXPLICIT *matctx,BV W)
525: {
526:   PetscInt          i,j,d,n,n0,m0,n1,m1,nmat=pep->nmat,lda=nmat*k,deg=nmat-1;
527:   PetscInt          *idxg=matctx->idxg,*idxp=matctx->idxp,idx,ncols;
528:   Mat               M,*E=matctx->E,*A,*At,Mk,Md;
529:   PetscReal         *a=pep->pbc,*b=pep->pbc+nmat,*g=pep->pbc+2*nmat;
530:   PetscScalar       s,ss,*DHii,*T22,*T21,*T12,*Ts,*Tr,*array,*ts,sone=1.0,zero=0.0;
531:   PetscBLASInt      lds_,lda_,k_;
532:   const PetscInt    *idxmc;
533:   const PetscScalar *valsc,*carray;
534:   MatStructure      str;
535:   Vec               vc,vc0;
536:   PetscBool         flg;

538:   PetscFunctionBegin;
539:   PetscCall(PetscMalloc5(k*k,&T22,k*k,&T21,nmat*k*k,&T12,k*k,&Tr,k*k,&Ts));
540:   PetscCall(STGetMatStructure(pep->st,&str));
541:   PetscCall(KSPGetOperators(ksp,&M,NULL));
542:   PetscCall(MatGetOwnershipRange(E[1],&n1,&m1));
543:   PetscCall(MatGetOwnershipRange(E[0],&n0,&m0));
544:   PetscCall(MatGetOwnershipRange(M,&n,NULL));
545:   PetscCall(PetscMalloc1(nmat,&ts));
546:   PetscCall(STGetTransform(pep->st,&flg));
547:   if (flg) {
548:     PetscCall(PetscMalloc1(pep->nmat,&At));
549:     for (i=0;i<pep->nmat;i++) PetscCall(STGetMatrixTransformed(pep->st,i,&At[i]));
550:   } else At = pep->A;
551:   if (matctx->subc) A = matctx->A;
552:   else A = At;
553:   /* Form the explicit system matrix */
554:   DHii = T12;
555:   PetscCall(PetscArrayzero(DHii,k*k*nmat));
556:   for (i=0;i<k;i++) DHii[k+i+i*lda] = 1.0/a[0];
557:   for (d=2;d<nmat;d++) {
558:     for (j=0;j<k;j++) {
559:       for (i=0;i<k;i++) {
560:         DHii[d*k+i+j*lda] = ((h-b[d-1])*DHii[(d-1)*k+i+j*lda]+fH[(d-1)*k+i+j*lda]-g[d-1]*DHii[(d-2)*k+i+j*lda])/a[d-1];
561:       }
562:     }
563:   }

565:   /* T11 */
566:   if (!matctx->compM1) {
567:     PetscCall(MatCopy(A[0],E[0],DIFFERENT_NONZERO_PATTERN));
568:     PetscCall(PEPEvaluateBasis(pep,h,0,Ts,NULL));
569:     for (j=1;j<nmat;j++) PetscCall(MatAXPY(E[0],Ts[j],A[j],str));
570:   }
571:   for (i=n0;i<m0;i++) {
572:     PetscCall(MatGetRow(E[0],i,&ncols,&idxmc,&valsc));
573:     idx = n+i-n0;
574:     for (j=0;j<ncols;j++) {
575:       idxg[j] = matctx->map0[idxmc[j]];
576:     }
577:     PetscCall(MatSetValues(M,1,&idx,ncols,idxg,valsc,INSERT_VALUES));
578:     PetscCall(MatRestoreRow(E[0],i,&ncols,&idxmc,&valsc));
579:   }

581:   /* T22 */
582:   PetscCall(PetscBLASIntCast(lds,&lds_));
583:   PetscCall(PetscBLASIntCast(k,&k_));
584:   PetscCall(PetscBLASIntCast(lda,&lda_));
585:   PetscCallBLAS("BLASgemm",BLASgemm_("C","N",&k_,&k_,&k_,&sone,S,&lds_,S,&lds_,&zero,Tr,&k_));
586:   for (i=1;i<deg;i++) {
587:     PetscCallBLAS("BLASgemm",BLASgemm_("N","N",&k_,&k_,&k_,&sone,Tr,&k_,DHii+i*k,&lda_,&zero,Ts,&k_));
588:     s = (i==1)?0.0:1.0;
589:     PetscCallBLAS("BLASgemm",BLASgemm_("C","N",&k_,&k_,&k_,&sone,fH+i*k,&lda_,Ts,&k_,&s,T22,&k_));
590:   }
591:   for (j=0;j<k;j++) idxp[j] = matctx->map1[j];
592:   for (i=0;i<m1-n1;i++) {
593:     idx = n+m0-n0+i;
594:     for (j=0;j<k;j++) {
595:       Tr[j] = T22[n1+i+j*k];
596:     }
597:     PetscCall(MatSetValues(M,1,&idx,k,idxp,Tr,INSERT_VALUES));
598:   }

600:   /* T21 */
601:   for (i=1;i<deg;i++) {
602:     s = (i==1)?0.0:1.0;
603:     ss = PetscConj(fh[i]);
604:     PetscCallBLAS("BLASgemm",BLASgemm_("N","N",&k_,&k_,&k_,&ss,S,&lds_,fH+i*k,&lda_,&s,T21,&k_));
605:   }
606:   PetscCall(BVSetActiveColumns(W,0,k));
607:   PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,k,k,T21,&Mk));
608:   PetscCall(BVMult(W,1.0,0.0,V,Mk));
609:   for (i=0;i<k;i++) {
610:     PetscCall(BVGetColumn(W,i,&vc));
611:     PetscCall(VecConjugate(vc));
612:     PetscCall(VecGetArrayRead(vc,&carray));
613:     idx = matctx->map1[i];
614:     PetscCall(MatSetValues(M,1,&idx,m0-n0,matctx->map0+n0,carray,INSERT_VALUES));
615:     PetscCall(VecRestoreArrayRead(vc,&carray));
616:     PetscCall(BVRestoreColumn(W,i,&vc));
617:   }

619:   /* T12 */
620:   for (i=1;i<nmat;i++) {
621:     PetscCallBLAS("BLASgemm",BLASgemm_("N","N",&k_,&k_,&k_,&sone,S,&lds_,DHii+i*k,&lda_,&zero,Ts,&k_));
622:     for (j=0;j<k;j++) PetscCall(PetscArraycpy(T12+i*k+j*lda,Ts+j*k,k));
623:   }
624:   PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,k,nmat-1,NULL,&Md));
625:   for (i=0;i<nmat;i++) ts[i] = 1.0;
626:   for (j=0;j<k;j++) {
627:     PetscCall(MatDenseGetArrayWrite(Md,&array));
628:     PetscCall(PetscArraycpy(array,T12+k+j*lda,(nmat-1)*k));
629:     PetscCall(MatDenseRestoreArrayWrite(Md,&array));
630:     PetscCall(BVSetActiveColumns(W,0,nmat-1));
631:     PetscCall(BVMult(W,1.0,0.0,V,Md));
632:     for (i=nmat-1;i>0;i--) {
633:       PetscCall(BVGetColumn(W,i-1,&vc0));
634:       PetscCall(BVGetColumn(W,i,&vc));
635:       PetscCall(MatMult(A[i],vc0,vc));
636:       PetscCall(BVRestoreColumn(W,i-1,&vc0));
637:       PetscCall(BVRestoreColumn(W,i,&vc));
638:     }
639:     PetscCall(BVSetActiveColumns(W,1,nmat));
640:     PetscCall(BVGetColumn(W,0,&vc0));
641:     PetscCall(BVMultVec(W,1.0,0.0,vc0,ts));
642:     PetscCall(VecGetArrayRead(vc0,&carray));
643:     idx = matctx->map1[j];
644:     PetscCall(MatSetValues(M,m0-n0,matctx->map0+n0,1,&idx,carray,INSERT_VALUES));
645:     PetscCall(VecRestoreArrayRead(vc0,&carray));
646:     PetscCall(BVRestoreColumn(W,0,&vc0));
647:   }
648:   PetscCall(MatAssemblyBegin(M,MAT_FINAL_ASSEMBLY));
649:   PetscCall(MatAssemblyEnd(M,MAT_FINAL_ASSEMBLY));
650:   PetscCall(PEP_KSPSetOperators(ksp,M,M));
651:   PetscCall(KSPSetUp(ksp));
652:   PetscCall(PetscFree(ts));
653:   PetscCall(MatDestroy(&Mk));
654:   PetscCall(MatDestroy(&Md));
655:   if (flg) PetscCall(PetscFree(At));
656:   PetscCall(PetscFree5(T22,T21,T12,Tr,Ts));
657:   PetscFunctionReturn(PETSC_SUCCESS);
658: }

660: static PetscErrorCode NRefSysSolve_explicit(PetscInt k,KSP ksp,Vec Rv,PetscScalar *Rh,Vec dVi,PetscScalar *dHi,PEP_REFINE_EXPLICIT *matctx)
661: {
662:   PetscInt          n0,m0,n1,m1,i;
663:   PetscScalar       *arrayV;
664:   const PetscScalar *array;

666:   PetscFunctionBegin;
667:   PetscCall(MatGetOwnershipRange(matctx->E[1],&n1,&m1));
668:   PetscCall(MatGetOwnershipRange(matctx->E[0],&n0,&m0));

670:   /* Right side */
671:   PetscCall(VecGetArrayRead(Rv,&array));
672:   PetscCall(VecSetValues(matctx->tN,m0-n0,matctx->map0+n0,array,INSERT_VALUES));
673:   PetscCall(VecRestoreArrayRead(Rv,&array));
674:   PetscCall(VecSetValues(matctx->tN,m1-n1,matctx->map1+n1,Rh+n1,INSERT_VALUES));
675:   PetscCall(VecAssemblyBegin(matctx->tN));
676:   PetscCall(VecAssemblyEnd(matctx->tN));

678:   /* Solve */
679:   PetscCall(KSPSolve(ksp,matctx->tN,matctx->ttN));

681:   /* Retrieve solution */
682:   PetscCall(VecGetArray(dVi,&arrayV));
683:   PetscCall(VecGetArrayRead(matctx->ttN,&array));
684:   PetscCall(PetscArraycpy(arrayV,array,m0-n0));
685:   PetscCall(VecRestoreArray(dVi,&arrayV));
686:   if (!matctx->subc) {
687:     PetscCall(VecGetArray(matctx->t1,&arrayV));
688:     for (i=0;i<m1-n1;i++) arrayV[i] =  array[m0-n0+i];
689:     PetscCall(VecRestoreArray(matctx->t1,&arrayV));
690:     PetscCall(VecRestoreArrayRead(matctx->ttN,&array));
691:     PetscCall(VecScatterBegin(matctx->scatterctx,matctx->t1,matctx->vseq,INSERT_VALUES,SCATTER_FORWARD));
692:     PetscCall(VecScatterEnd(matctx->scatterctx,matctx->t1,matctx->vseq,INSERT_VALUES,SCATTER_FORWARD));
693:     PetscCall(VecGetArrayRead(matctx->vseq,&array));
694:     for (i=0;i<k;i++) dHi[i] = array[i];
695:     PetscCall(VecRestoreArrayRead(matctx->vseq,&array));
696:   }
697:   PetscFunctionReturn(PETSC_SUCCESS);
698: }

700: static PetscErrorCode NRefSysIter(PetscInt i,PEP pep,PetscInt k,KSP ksp,PetscScalar *fH,PetscScalar *S,PetscInt lds,PetscScalar *fh,PetscScalar *H,PetscInt ldh,Vec Rv,PetscScalar *Rh,BV V,Vec dVi,PetscScalar *dHi,PEP_REFINE_EXPLICIT *matctx,BV W)
701: {
702:   PetscInt            j,m,lda=pep->nmat*k,n0,m0,idx;
703:   PetscMPIInt         root,len;
704:   PetscScalar         *array2,h;
705:   const PetscScalar   *array;
706:   Vec                 R,Vi;
707:   PEP_REFINE_MATSHELL *ctx;
708:   Mat                 M;

710:   PetscFunctionBegin;
711:   if (!matctx || !matctx->subc) {
712:     for (j=0;j<pep->nmat;j++) fh[j] = fH[j*k+i+i*lda];
713:     h   = H[i+i*ldh];
714:     idx = i;
715:     R   = Rv;
716:     Vi  = dVi;
717:     switch (pep->scheme) {
718:     case PEP_REFINE_SCHEME_EXPLICIT:
719:       PetscCall(NRefSysSetup_explicit(pep,k,ksp,fH,S,lds,fh,h,V,matctx,W));
720:       matctx->compM1 = PETSC_FALSE;
721:       break;
722:     case PEP_REFINE_SCHEME_MBE:
723:       PetscCall(NRefSysSetup_mbe(pep,k,ksp,fH,S,lds,fh,h,V,matctx));
724:       matctx->compM1 = PETSC_FALSE;
725:       break;
726:     case PEP_REFINE_SCHEME_SCHUR:
727:       PetscCall(KSPGetOperators(ksp,&M,NULL));
728:       PetscCall(MatShellGetContext(M,&ctx));
729:       PetscCall(NRefSysSetup_shell(pep,k,fH,S,lds,fh,h,ctx));
730:       ctx->compM1 = PETSC_FALSE;
731:       break;
732:     }
733:   } else {
734:     if (i%matctx->subc->n==0 && (idx=i+matctx->subc->color)<k) {
735:       for (j=0;j<pep->nmat;j++) fh[j] = fH[j*k+idx+idx*lda];
736:       h = H[idx+idx*ldh];
737:       matctx->idx = idx;
738:       switch (pep->scheme) {
739:       case PEP_REFINE_SCHEME_EXPLICIT:
740:         PetscCall(NRefSysSetup_explicit(pep,k,ksp,fH,S,lds,fh,h,matctx->V,matctx,matctx->W));
741:         matctx->compM1 = PETSC_FALSE;
742:         break;
743:       case PEP_REFINE_SCHEME_MBE:
744:         PetscCall(NRefSysSetup_mbe(pep,k,ksp,fH,S,lds,fh,h,matctx->V,matctx));
745:         matctx->compM1 = PETSC_FALSE;
746:         break;
747:       case PEP_REFINE_SCHEME_SCHUR:
748:         break;
749:       }
750:     } else idx = matctx->idx;
751:     PetscCall(VecScatterBegin(matctx->scatter_id[i%matctx->subc->n],Rv,matctx->tg,INSERT_VALUES,SCATTER_FORWARD));
752:     PetscCall(VecScatterEnd(matctx->scatter_id[i%matctx->subc->n],Rv,matctx->tg,INSERT_VALUES,SCATTER_FORWARD));
753:     PetscCall(VecGetArrayRead(matctx->tg,&array));
754:     PetscCall(VecPlaceArray(matctx->t,array));
755:     PetscCall(VecCopy(matctx->t,matctx->Rv));
756:     PetscCall(VecResetArray(matctx->t));
757:     PetscCall(VecRestoreArrayRead(matctx->tg,&array));
758:     R  = matctx->Rv;
759:     Vi = matctx->Vi;
760:   }
761:   if (idx==i && idx<k) {
762:     switch (pep->scheme) {
763:       case PEP_REFINE_SCHEME_EXPLICIT:
764:         PetscCall(NRefSysSolve_explicit(k,ksp,R,Rh,Vi,dHi,matctx));
765:         break;
766:       case PEP_REFINE_SCHEME_MBE:
767:         PetscCall(NRefSysSolve_mbe(k,k,matctx->W,matctx->w,matctx->Wt,matctx->wt,matctx->d,matctx->dt,ksp,matctx->M2,matctx->M3 ,matctx->M4,PETSC_FALSE,R,Rh,Vi,dHi,matctx->t));
768:         break;
769:       case PEP_REFINE_SCHEME_SCHUR:
770:         PetscCall(NRefSysSolve_shell(ksp,pep->nmat,R,Rh,k,Vi,dHi));
771:         break;
772:     }
773:   }
774:   if (matctx && matctx->subc) {
775:     PetscCall(VecGetLocalSize(Vi,&m));
776:     PetscCall(VecGetArrayRead(Vi,&array));
777:     PetscCall(VecGetArray(matctx->tg,&array2));
778:     PetscCall(PetscArraycpy(array2,array,m));
779:     PetscCall(VecRestoreArray(matctx->tg,&array2));
780:     PetscCall(VecRestoreArrayRead(Vi,&array));
781:     PetscCall(VecScatterBegin(matctx->scatter_id[i%matctx->subc->n],matctx->tg,dVi,INSERT_VALUES,SCATTER_REVERSE));
782:     PetscCall(VecScatterEnd(matctx->scatter_id[i%matctx->subc->n],matctx->tg,dVi,INSERT_VALUES,SCATTER_REVERSE));
783:     switch (pep->scheme) {
784:     case PEP_REFINE_SCHEME_EXPLICIT:
785:       PetscCall(MatGetOwnershipRange(matctx->E[0],&n0,&m0));
786:       PetscCall(VecGetArrayRead(matctx->ttN,&array));
787:       PetscCall(VecPlaceArray(matctx->tp,array+m0-n0));
788:       PetscCall(VecScatterBegin(matctx->scatterp_id[i%matctx->subc->n],matctx->tp,matctx->tpg,INSERT_VALUES,SCATTER_FORWARD));
789:       PetscCall(VecScatterEnd(matctx->scatterp_id[i%matctx->subc->n],matctx->tp,matctx->tpg,INSERT_VALUES,SCATTER_FORWARD));
790:       PetscCall(VecResetArray(matctx->tp));
791:       PetscCall(VecRestoreArrayRead(matctx->ttN,&array));
792:       PetscCall(VecGetArrayRead(matctx->tpg,&array));
793:       for (j=0;j<k;j++) dHi[j] = array[j];
794:       PetscCall(VecRestoreArrayRead(matctx->tpg,&array));
795:       break;
796:      case PEP_REFINE_SCHEME_MBE:
797:       root = 0;
798:       for (j=0;j<i%matctx->subc->n;j++) root += matctx->subc->subsize[j];
799:       PetscCall(PetscMPIIntCast(k,&len));
800:       PetscCallMPI(MPI_Bcast(dHi,len,MPIU_SCALAR,root,matctx->subc->dupparent));
801:       break;
802:     case PEP_REFINE_SCHEME_SCHUR:
803:       break;
804:     }
805:   }
806:   PetscFunctionReturn(PETSC_SUCCESS);
807: }

809: static PetscErrorCode PEPNRefForwardSubstitution(PEP pep,PetscInt k,PetscScalar *S,PetscInt lds,PetscScalar *H,PetscInt ldh,PetscScalar *fH,BV dV,PetscScalar *dVS,PetscInt *rds,PetscScalar *dH,PetscInt lddh,KSP ksp,PEP_REFINE_EXPLICIT *matctx)
810: {
811:   PetscInt            i,nmat=pep->nmat,lda=nmat*k;
812:   PetscScalar         *fh,*Rh,*DfH;
813:   PetscReal           norm;
814:   BV                  W;
815:   Vec                 Rv,t,dvi;
816:   PEP_REFINE_MATSHELL *ctx;
817:   Mat                 M,*At;
818:   PetscBool           flg,lindep;

820:   PetscFunctionBegin;
821:   PetscCall(PetscMalloc2(nmat*k*k,&DfH,k,&Rh));
822:   *rds = 0;
823:   PetscCall(BVCreateVec(pep->V,&Rv));
824:   switch (pep->scheme) {
825:   case PEP_REFINE_SCHEME_EXPLICIT:
826:     PetscCall(BVCreateVec(pep->V,&t));
827:     PetscCall(BVDuplicateResize(pep->V,PetscMax(k,nmat),&W));
828:     PetscCall(PetscMalloc1(nmat,&fh));
829:     break;
830:   case PEP_REFINE_SCHEME_MBE:
831:     if (matctx->subc) {
832:       PetscCall(BVCreateVec(pep->V,&t));
833:       PetscCall(BVDuplicateResize(pep->V,PetscMax(k,nmat),&W));
834:     } else {
835:       W = matctx->W;
836:       PetscCall(PetscObjectReference((PetscObject)W));
837:       t = matctx->t;
838:       PetscCall(PetscObjectReference((PetscObject)t));
839:     }
840:     PetscCall(BVScale(matctx->W,0.0));
841:     PetscCall(BVScale(matctx->Wt,0.0));
842:     PetscCall(BVScale(matctx->M2,0.0));
843:     PetscCall(BVScale(matctx->M3,0.0));
844:     PetscCall(PetscMalloc1(nmat,&fh));
845:     break;
846:   case PEP_REFINE_SCHEME_SCHUR:
847:     PetscCall(KSPGetOperators(ksp,&M,NULL));
848:     PetscCall(MatShellGetContext(M,&ctx));
849:     PetscCall(BVCreateVec(pep->V,&t));
850:     PetscCall(BVDuplicateResize(pep->V,PetscMax(k,nmat),&W));
851:     fh = ctx->fih;
852:     break;
853:   }
854:   PetscCall(PetscArrayzero(dVS,2*k*k));
855:   PetscCall(PetscArrayzero(DfH,lda*k));
856:   PetscCall(STGetTransform(pep->st,&flg));
857:   if (flg) {
858:     PetscCall(PetscMalloc1(pep->nmat,&At));
859:     for (i=0;i<pep->nmat;i++) PetscCall(STGetMatrixTransformed(pep->st,i,&At[i]));
860:   } else At = pep->A;

862:   /* Main loop for computing the i-th columns of dX and dS */
863:   for (i=0;i<k;i++) {
864:     /* Compute and update i-th column of the right hand side */
865:     PetscCall(PetscArrayzero(Rh,k));
866:     PetscCall(NRefRightSide(nmat,pep->pbc,At,k,pep->V,S,lds,i,H,ldh,fH,DfH,dH,dV,dVS,*rds,Rv,Rh,W,t));

868:     /* Update and solve system */
869:     PetscCall(BVGetColumn(dV,i,&dvi));
870:     PetscCall(NRefSysIter(i,pep,k,ksp,fH,S,lds,fh,H,ldh,Rv,Rh,pep->V,dvi,dH+i*k,matctx,W));
871:     /* Orthogonalize computed solution */
872:     PetscCall(BVOrthogonalizeVec(pep->V,dvi,dVS+i*2*k,&norm,&lindep));
873:     PetscCall(BVRestoreColumn(dV,i,&dvi));
874:     if (!lindep) {
875:       PetscCall(BVOrthogonalizeColumn(dV,i,dVS+k+i*2*k,&norm,&lindep));
876:       if (!lindep) {
877:         dVS[k+i+i*2*k] = norm;
878:         PetscCall(BVScaleColumn(dV,i,1.0/norm));
879:         (*rds)++;
880:       }
881:     }
882:   }
883:   PetscCall(BVSetActiveColumns(dV,0,*rds));
884:   PetscCall(VecDestroy(&t));
885:   PetscCall(VecDestroy(&Rv));
886:   PetscCall(BVDestroy(&W));
887:   if (flg) PetscCall(PetscFree(At));
888:   PetscCall(PetscFree2(DfH,Rh));
889:   if (pep->scheme!=PEP_REFINE_SCHEME_SCHUR) PetscCall(PetscFree(fh));
890:   PetscFunctionReturn(PETSC_SUCCESS);
891: }

893: static PetscErrorCode NRefOrthogStep(PEP pep,PetscInt k,PetscScalar *H,PetscInt ldh,PetscScalar *fH,PetscScalar *S,PetscInt lds)
894: {
895:   PetscInt       j,nmat=pep->nmat,deg=nmat-1,lda=nmat*k,ldg;
896:   PetscScalar    *G,*tau,sone=1.0,zero=0.0,*work;
897:   PetscBLASInt   lds_,k_,ldh_,info,ldg_,lda_;

899:   PetscFunctionBegin;
900:   PetscCall(PetscMalloc3(k,&tau,k,&work,deg*k*k,&G));
901:   PetscCall(PetscBLASIntCast(lds,&lds_));
902:   PetscCall(PetscBLASIntCast(lda,&lda_));
903:   PetscCall(PetscBLASIntCast(k,&k_));

905:   /* Form auxiliary matrix for the orthogonalization step */
906:   ldg = deg*k;
907:   PetscCall(PEPEvaluateBasisforMatrix(pep,nmat,k,H,ldh,fH));
908:   PetscCall(PetscBLASIntCast(ldg,&ldg_));
909:   PetscCall(PetscBLASIntCast(ldh,&ldh_));
910:   for (j=0;j<deg;j++) {
911:     PetscCallBLAS("BLASgemm",BLASgemm_("N","N",&k_,&k_,&k_,&sone,S,&lds_,fH+j*k,&lda_,&zero,G+j*k,&ldg_));
912:   }
913:   /* Orthogonalize and update S */
914:   PetscCall(PetscFPTrapPush(PETSC_FP_TRAP_OFF));
915:   PetscCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&ldg_,&k_,G,&ldg_,tau,work,&k_,&info));
916:   PetscCall(PetscFPTrapPop());
917:   SlepcCheckLapackInfo("geqrf",info);
918:   PetscCallBLAS("BLAStrsm",BLAStrsm_("R","U","N","N",&k_,&k_,&sone,G,&ldg_,S,&lds_));

920:   /* Update H */
921:   PetscCallBLAS("BLAStrmm",BLAStrmm_("L","U","N","N",&k_,&k_,&sone,G,&ldg_,H,&ldh_));
922:   PetscCallBLAS("BLAStrsm",BLAStrsm_("R","U","N","N",&k_,&k_,&sone,G,&ldg_,H,&ldh_));
923:   PetscCall(PetscFree3(tau,work,G));
924:   PetscFunctionReturn(PETSC_SUCCESS);
925: }

927: static PetscErrorCode PEPNRefUpdateInvPair(PEP pep,PetscInt k,PetscScalar *H,PetscInt ldh,PetscScalar *fH,PetscScalar *dH,PetscScalar *S,PetscInt lds,BV dV,PetscScalar *dVS,PetscInt rds)
928: {
929:   PetscInt       i,j,nmat=pep->nmat,lda=nmat*k;
930:   PetscScalar    *tau,*array,*work;
931:   PetscBLASInt   lds_,k_,lda_,ldh_,kdrs_,info,k2_;
932:   Mat            M0;

934:   PetscFunctionBegin;
935:   PetscCall(PetscMalloc2(k,&tau,k,&work));
936:   PetscCall(PetscBLASIntCast(lds,&lds_));
937:   PetscCall(PetscBLASIntCast(lda,&lda_));
938:   PetscCall(PetscBLASIntCast(ldh,&ldh_));
939:   PetscCall(PetscBLASIntCast(k,&k_));
940:   PetscCall(PetscBLASIntCast(2*k,&k2_));
941:   PetscCall(PetscBLASIntCast((k+rds),&kdrs_));
942:   /* Update H */
943:   for (j=0;j<k;j++) {
944:     for (i=0;i<k;i++) H[i+j*ldh] -= dH[i+j*k];
945:   }
946:   /* Update V */
947:   for (j=0;j<k;j++) {
948:     for (i=0;i<k;i++) dVS[i+j*2*k] = -dVS[i+j*2*k]+S[i+j*lds];
949:     for (i=k;i<2*k;i++) dVS[i+j*2*k] = -dVS[i+j*2*k];
950:   }
951:   PetscCall(PetscFPTrapPush(PETSC_FP_TRAP_OFF));
952:   PetscCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&kdrs_,&k_,dVS,&k2_,tau,work,&k_,&info));
953:   SlepcCheckLapackInfo("geqrf",info);
954:   /* Copy triangular matrix in S */
955:   for (j=0;j<k;j++) {
956:     for (i=0;i<=j;i++) S[i+j*lds] = dVS[i+j*2*k];
957:     for (i=j+1;i<k;i++) S[i+j*lds] = 0.0;
958:   }
959:   PetscCallBLAS("LAPACKorgqr",LAPACKorgqr_(&k2_,&k_,&k_,dVS,&k2_,tau,work,&k_,&info));
960:   SlepcCheckLapackInfo("orgqr",info);
961:   PetscCall(PetscFPTrapPop());
962:   PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,k,k,NULL,&M0));
963:   PetscCall(MatDenseGetArrayWrite(M0,&array));
964:   for (j=0;j<k;j++) PetscCall(PetscArraycpy(array+j*k,dVS+j*2*k,k));
965:   PetscCall(MatDenseRestoreArrayWrite(M0,&array));
966:   PetscCall(BVMultInPlace(pep->V,M0,0,k));
967:   if (rds) {
968:     PetscCall(MatDenseGetArrayWrite(M0,&array));
969:     for (j=0;j<k;j++) PetscCall(PetscArraycpy(array+j*k,dVS+k+j*2*k,rds));
970:     PetscCall(MatDenseRestoreArrayWrite(M0,&array));
971:     PetscCall(BVMultInPlace(dV,M0,0,k));
972:     PetscCall(BVMult(pep->V,1.0,1.0,dV,NULL));
973:   }
974:   PetscCall(MatDestroy(&M0));
975:   PetscCall(NRefOrthogStep(pep,k,H,ldh,fH,S,lds));
976:   PetscCall(PetscFree2(tau,work));
977:   PetscFunctionReturn(PETSC_SUCCESS);
978: }

980: static PetscErrorCode PEPNRefSetUp(PEP pep,PetscInt k,PetscScalar *H,PetscInt ldh,PEP_REFINE_EXPLICIT *matctx,PetscBool ini)
981: {
982:   PEP_REFINE_MATSHELL *ctx;
983:   PetscScalar         t,*coef;
984:   const PetscScalar   *array;
985:   MatStructure        str;
986:   PetscInt            j,nmat=pep->nmat,n0,m0,n1,m1,n0_,m0_,n1_,m1_,N0,N1,p,*idx1,*idx2,count,si,i,l0;
987:   MPI_Comm            comm;
988:   PetscMPIInt         np;
989:   const PetscInt      *rgs0,*rgs1;
990:   Mat                 B,C,*E,*A,*At;
991:   IS                  is1,is2;
992:   Vec                 v;
993:   PetscBool           flg;
994:   Mat                 M,P;

996:   PetscFunctionBegin;
997:   PetscCall(PetscMalloc1(nmat,&coef));
998:   PetscCall(STGetTransform(pep->st,&flg));
999:   if (flg) {
1000:     PetscCall(PetscMalloc1(pep->nmat,&At));
1001:     for (i=0;i<pep->nmat;i++) PetscCall(STGetMatrixTransformed(pep->st,i,&At[i]));
1002:   } else At = pep->A;
1003:   switch (pep->scheme) {
1004:   case PEP_REFINE_SCHEME_EXPLICIT:
1005:     if (ini) {
1006:       if (matctx->subc) {
1007:         A = matctx->A;
1008:         PetscCall(PetscSubcommGetChild(matctx->subc,&comm));
1009:       } else {
1010:         A = At;
1011:         PetscCall(PetscObjectGetComm((PetscObject)pep,&comm));
1012:       }
1013:       E = matctx->E;
1014:       PetscCall(STGetMatStructure(pep->st,&str));
1015:       PetscCall(MatDuplicate(A[0],MAT_COPY_VALUES,&E[0]));
1016:       j = (matctx->subc)?matctx->subc->color:0;
1017:       PetscCall(PEPEvaluateBasis(pep,H[j+j*ldh],0,coef,NULL));
1018:       for (j=1;j<nmat;j++) PetscCall(MatAXPY(E[0],coef[j],A[j],str));
1019:       PetscCall(MatCreateDense(comm,PETSC_DECIDE,PETSC_DECIDE,k,k,NULL,&E[1]));
1020:       PetscCall(MatGetOwnershipRange(E[0],&n0,&m0));
1021:       PetscCall(MatGetOwnershipRange(E[1],&n1,&m1));
1022:       PetscCall(MatGetOwnershipRangeColumn(E[0],&n0_,&m0_));
1023:       PetscCall(MatGetOwnershipRangeColumn(E[1],&n1_,&m1_));
1024:       /* T12 and T21 are computed from V and V*, so,
1025:          they must have the same column and row ranges */
1026:       PetscCheck(m0_-n0_==m0-n0,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Inconsistent dimensions");
1027:       PetscCall(MatCreateDense(comm,m0-n0,m1_-n1_,PETSC_DECIDE,PETSC_DECIDE,NULL,&B));
1028:       PetscCall(MatCreateDense(comm,m1-n1,m0_-n0_,PETSC_DECIDE,PETSC_DECIDE,NULL,&C));
1029:       PetscCall(MatCreateTile(1.0,E[0],1.0,B,1.0,C,1.0,E[1],&M));
1030:       PetscCall(MatDestroy(&B));
1031:       PetscCall(MatDestroy(&C));
1032:       matctx->compM1 = PETSC_TRUE;
1033:       PetscCall(MatGetSize(E[0],NULL,&N0));
1034:       PetscCall(MatGetSize(E[1],NULL,&N1));
1035:       PetscCallMPI(MPI_Comm_size(PetscObjectComm((PetscObject)M),&np));
1036:       PetscCall(MatGetOwnershipRanges(E[0],&rgs0));
1037:       PetscCall(MatGetOwnershipRanges(E[1],&rgs1));
1038:       PetscCall(PetscMalloc4(PetscMax(k,N1),&matctx->idxp,N0,&matctx->idxg,N0,&matctx->map0,N1,&matctx->map1));
1039:       /* Create column (and row) mapping */
1040:       for (p=0;p<np;p++) {
1041:         for (j=rgs0[p];j<rgs0[p+1];j++) matctx->map0[j] = j+rgs1[p];
1042:         for (j=rgs1[p];j<rgs1[p+1];j++) matctx->map1[j] = j+rgs0[p+1];
1043:       }
1044:       PetscCall(MatCreateVecs(M,NULL,&matctx->tN));
1045:       PetscCall(MatCreateVecs(matctx->E[1],NULL,&matctx->t1));
1046:       PetscCall(VecDuplicate(matctx->tN,&matctx->ttN));
1047:       if (matctx->subc) {
1048:         PetscCallMPI(MPI_Comm_size(PetscObjectComm((PetscObject)pep),&np));
1049:         count = np*k;
1050:         PetscCall(PetscMalloc2(count,&idx1,count,&idx2));
1051:         PetscCall(VecCreateMPI(PetscObjectComm((PetscObject)pep),m1-n1,PETSC_DECIDE,&matctx->tp));
1052:         PetscCall(VecGetOwnershipRange(matctx->tp,&l0,NULL));
1053:         PetscCall(VecCreateMPI(PetscObjectComm((PetscObject)pep),k,PETSC_DECIDE,&matctx->tpg));
1054:         for (si=0;si<matctx->subc->n;si++) {
1055:           if (matctx->subc->color==si) {
1056:             j=0;
1057:             if (matctx->subc->color==si) {
1058:               for (p=0;p<np;p++) {
1059:                 for (i=n1;i<m1;i++) {
1060:                   idx1[j] = l0+i-n1;
1061:                   idx2[j++] =p*k+i;
1062:                 }
1063:               }
1064:             }
1065:             count = np*(m1-n1);
1066:           } else count =0;
1067:           PetscCall(ISCreateGeneral(PetscObjectComm((PetscObject)pep),count,idx1,PETSC_COPY_VALUES,&is1));
1068:           PetscCall(ISCreateGeneral(PetscObjectComm((PetscObject)pep),count,idx2,PETSC_COPY_VALUES,&is2));
1069:           PetscCall(VecScatterCreate(matctx->tp,is1,matctx->tpg,is2,&matctx->scatterp_id[si]));
1070:           PetscCall(ISDestroy(&is1));
1071:           PetscCall(ISDestroy(&is2));
1072:         }
1073:         PetscCall(PetscFree2(idx1,idx2));
1074:       } else PetscCall(VecScatterCreateToAll(matctx->t1,&matctx->scatterctx,&matctx->vseq));
1075:       P = M;
1076:     } else {
1077:       if (matctx->subc) {
1078:         /* Scatter vectors pep->V */
1079:         for (i=0;i<k;i++) {
1080:           PetscCall(BVGetColumn(pep->V,i,&v));
1081:           PetscCall(VecScatterBegin(matctx->scatter_sub,v,matctx->tg,INSERT_VALUES,SCATTER_FORWARD));
1082:           PetscCall(VecScatterEnd(matctx->scatter_sub,v,matctx->tg,INSERT_VALUES,SCATTER_FORWARD));
1083:           PetscCall(BVRestoreColumn(pep->V,i,&v));
1084:           PetscCall(VecGetArrayRead(matctx->tg,&array));
1085:           PetscCall(VecPlaceArray(matctx->t,(const PetscScalar*)array));
1086:           PetscCall(BVInsertVec(matctx->V,i,matctx->t));
1087:           PetscCall(VecResetArray(matctx->t));
1088:           PetscCall(VecRestoreArrayRead(matctx->tg,&array));
1089:         }
1090:       }
1091:     }
1092:     break;
1093:   case PEP_REFINE_SCHEME_MBE:
1094:     if (ini) {
1095:       if (matctx->subc) {
1096:         A = matctx->A;
1097:         PetscCall(PetscSubcommGetChild(matctx->subc,&comm));
1098:       } else {
1099:         matctx->V = pep->V;
1100:         A = At;
1101:         PetscCall(PetscObjectGetComm((PetscObject)pep,&comm));
1102:         PetscCall(MatCreateVecs(pep->A[0],&matctx->t,NULL));
1103:       }
1104:       PetscCall(STGetMatStructure(pep->st,&str));
1105:       PetscCall(MatDuplicate(A[0],MAT_COPY_VALUES,&matctx->M1));
1106:       j = (matctx->subc)?matctx->subc->color:0;
1107:       PetscCall(PEPEvaluateBasis(pep,H[j+j*ldh],0,coef,NULL));
1108:       for (j=1;j<nmat;j++) PetscCall(MatAXPY(matctx->M1,coef[j],A[j],str));
1109:       PetscCall(BVDuplicateResize(matctx->V,PetscMax(k,pep->nmat),&matctx->W));
1110:       PetscCall(BVDuplicateResize(matctx->V,k,&matctx->M2));
1111:       PetscCall(BVDuplicate(matctx->M2,&matctx->M3));
1112:       PetscCall(BVDuplicate(matctx->M2,&matctx->Wt));
1113:       PetscCall(PetscMalloc5(k*k,&matctx->M4,k*k,&matctx->w,k*k,&matctx->wt,k,&matctx->d,k,&matctx->dt));
1114:       matctx->compM1 = PETSC_TRUE;
1115:       M = matctx->M1;
1116:       P = M;
1117:     }
1118:     break;
1119:   case PEP_REFINE_SCHEME_SCHUR:
1120:     if (ini) {
1121:       PetscCall(PetscObjectGetComm((PetscObject)pep,&comm));
1122:       PetscCall(MatGetSize(At[0],&m0,&n0));
1123:       PetscCall(PetscMalloc1(1,&ctx));
1124:       PetscCall(STGetMatStructure(pep->st,&str));
1125:       /* Create a shell matrix to solve the linear system */
1126:       ctx->V = pep->V;
1127:       ctx->k = k; ctx->nmat = nmat;
1128:       PetscCall(PetscMalloc5(nmat,&ctx->A,k*k,&ctx->M4,k,&ctx->pM4,2*k*k,&ctx->work,nmat,&ctx->fih));
1129:       for (i=0;i<nmat;i++) ctx->A[i] = At[i];
1130:       PetscCall(PetscArrayzero(ctx->M4,k*k));
1131:       PetscCall(MatCreateShell(comm,PETSC_DECIDE,PETSC_DECIDE,m0,n0,ctx,&M));
1132:       PetscCall(MatShellSetOperation(M,MATOP_MULT,(void(*)(void))MatMult_FS));
1133:       PetscCall(BVDuplicateResize(ctx->V,PetscMax(k,pep->nmat),&ctx->W));
1134:       PetscCall(BVDuplicateResize(ctx->V,k,&ctx->M2));
1135:       PetscCall(BVDuplicate(ctx->M2,&ctx->M3));
1136:       PetscCall(BVCreateVec(pep->V,&ctx->t));
1137:       PetscCall(MatDuplicate(At[0],MAT_COPY_VALUES,&ctx->M1));
1138:       PetscCall(PEPEvaluateBasis(pep,H[0],0,coef,NULL));
1139:       for (j=1;j<nmat;j++) PetscCall(MatAXPY(ctx->M1,coef[j],At[j],str));
1140:       PetscCall(MatDuplicate(At[0],MAT_COPY_VALUES,&P));
1141:       /* Compute a precond matrix for the system */
1142:       t = H[0];
1143:       PetscCall(PEPEvaluateBasis(pep,t,0,coef,NULL));
1144:       for (j=1;j<nmat;j++) PetscCall(MatAXPY(P,coef[j],At[j],str));
1145:       ctx->compM1 = PETSC_TRUE;
1146:     }
1147:     break;
1148:   }
1149:   if (ini) {
1150:     PetscCall(PEPRefineGetKSP(pep,&pep->refineksp));
1151:     PetscCall(KSPSetErrorIfNotConverged(pep->refineksp,PETSC_TRUE));
1152:     PetscCall(PEP_KSPSetOperators(pep->refineksp,M,P));
1153:     PetscCall(KSPSetFromOptions(pep->refineksp));
1154:   }

1156:   if (!ini && matctx && matctx->subc) {
1157:      /* Scatter vectors pep->V */
1158:     for (i=0;i<k;i++) {
1159:       PetscCall(BVGetColumn(pep->V,i,&v));
1160:       PetscCall(VecScatterBegin(matctx->scatter_sub,v,matctx->tg,INSERT_VALUES,SCATTER_FORWARD));
1161:       PetscCall(VecScatterEnd(matctx->scatter_sub,v,matctx->tg,INSERT_VALUES,SCATTER_FORWARD));
1162:       PetscCall(BVRestoreColumn(pep->V,i,&v));
1163:       PetscCall(VecGetArrayRead(matctx->tg,&array));
1164:       PetscCall(VecPlaceArray(matctx->t,(const PetscScalar*)array));
1165:       PetscCall(BVInsertVec(matctx->V,i,matctx->t));
1166:       PetscCall(VecResetArray(matctx->t));
1167:       PetscCall(VecRestoreArrayRead(matctx->tg,&array));
1168:     }
1169:    }
1170:   PetscCall(PetscFree(coef));
1171:   if (flg) PetscCall(PetscFree(At));
1172:   PetscFunctionReturn(PETSC_SUCCESS);
1173: }

1175: static PetscErrorCode NRefSubcommSetup(PEP pep,PetscInt k,PEP_REFINE_EXPLICIT *matctx,PetscInt nsubc)
1176: {
1177:   PetscInt          i,si,j,m0,n0,nloc0,nloc_sub,*idx1,*idx2;
1178:   IS                is1,is2;
1179:   BVType            type;
1180:   Vec               v;
1181:   const PetscScalar *array;
1182:   Mat               *A;
1183:   PetscBool         flg;
1184:   MPI_Comm          contpar,child;

1186:   PetscFunctionBegin;
1187:   PetscCall(STGetTransform(pep->st,&flg));
1188:   if (flg) {
1189:     PetscCall(PetscMalloc1(pep->nmat,&A));
1190:     for (i=0;i<pep->nmat;i++) PetscCall(STGetMatrixTransformed(pep->st,i,&A[i]));
1191:   } else A = pep->A;
1192:   PetscCall(PetscSubcommGetChild(matctx->subc,&child));
1193:   PetscCall(PetscSubcommGetContiguousParent(matctx->subc,&contpar));

1195:   /* Duplicate pep matrices */
1196:   PetscCall(PetscMalloc3(pep->nmat,&matctx->A,nsubc,&matctx->scatter_id,nsubc,&matctx->scatterp_id));
1197:   for (i=0;i<pep->nmat;i++) PetscCall(MatCreateRedundantMatrix(A[i],0,child,MAT_INITIAL_MATRIX,&matctx->A[i]));

1199:   /* Create Scatter */
1200:   PetscCall(MatCreateVecs(matctx->A[0],&matctx->t,NULL));
1201:   PetscCall(MatGetLocalSize(matctx->A[0],&nloc_sub,NULL));
1202:   PetscCall(VecCreateMPI(contpar,nloc_sub,PETSC_DECIDE,&matctx->tg));
1203:   PetscCall(BVGetColumn(pep->V,0,&v));
1204:   PetscCall(VecGetOwnershipRange(v,&n0,&m0));
1205:   nloc0 = m0-n0;
1206:   PetscCall(PetscMalloc2(matctx->subc->n*nloc0,&idx1,matctx->subc->n*nloc0,&idx2));
1207:   j = 0;
1208:   for (si=0;si<matctx->subc->n;si++) {
1209:     for (i=n0;i<m0;i++) {
1210:       idx1[j]   = i;
1211:       idx2[j++] = i+pep->n*si;
1212:     }
1213:   }
1214:   PetscCall(ISCreateGeneral(PetscObjectComm((PetscObject)pep),matctx->subc->n*nloc0,idx1,PETSC_COPY_VALUES,&is1));
1215:   PetscCall(ISCreateGeneral(PetscObjectComm((PetscObject)pep),matctx->subc->n*nloc0,idx2,PETSC_COPY_VALUES,&is2));
1216:   PetscCall(VecScatterCreate(v,is1,matctx->tg,is2,&matctx->scatter_sub));
1217:   PetscCall(ISDestroy(&is1));
1218:   PetscCall(ISDestroy(&is2));
1219:   for (si=0;si<matctx->subc->n;si++) {
1220:     j=0;
1221:     for (i=n0;i<m0;i++) {
1222:       idx1[j] = i;
1223:       idx2[j++] = i+pep->n*si;
1224:     }
1225:     PetscCall(ISCreateGeneral(PetscObjectComm((PetscObject)pep),nloc0,idx1,PETSC_COPY_VALUES,&is1));
1226:     PetscCall(ISCreateGeneral(PetscObjectComm((PetscObject)pep),nloc0,idx2,PETSC_COPY_VALUES,&is2));
1227:     PetscCall(VecScatterCreate(v,is1,matctx->tg,is2,&matctx->scatter_id[si]));
1228:     PetscCall(ISDestroy(&is1));
1229:     PetscCall(ISDestroy(&is2));
1230:   }
1231:   PetscCall(BVRestoreColumn(pep->V,0,&v));
1232:   PetscCall(PetscFree2(idx1,idx2));

1234:   /* Duplicate pep->V vecs */
1235:   PetscCall(BVGetType(pep->V,&type));
1236:   PetscCall(BVCreate(child,&matctx->V));
1237:   PetscCall(BVSetType(matctx->V,type));
1238:   PetscCall(BVSetSizesFromVec(matctx->V,matctx->t,k));
1239:   if (pep->scheme==PEP_REFINE_SCHEME_EXPLICIT) PetscCall(BVDuplicateResize(matctx->V,PetscMax(k,pep->nmat),&matctx->W));
1240:   for (i=0;i<k;i++) {
1241:     PetscCall(BVGetColumn(pep->V,i,&v));
1242:     PetscCall(VecScatterBegin(matctx->scatter_sub,v,matctx->tg,INSERT_VALUES,SCATTER_FORWARD));
1243:     PetscCall(VecScatterEnd(matctx->scatter_sub,v,matctx->tg,INSERT_VALUES,SCATTER_FORWARD));
1244:     PetscCall(BVRestoreColumn(pep->V,i,&v));
1245:     PetscCall(VecGetArrayRead(matctx->tg,&array));
1246:     PetscCall(VecPlaceArray(matctx->t,(const PetscScalar*)array));
1247:     PetscCall(BVInsertVec(matctx->V,i,matctx->t));
1248:     PetscCall(VecResetArray(matctx->t));
1249:     PetscCall(VecRestoreArrayRead(matctx->tg,&array));
1250:   }

1252:   PetscCall(VecDuplicate(matctx->t,&matctx->Rv));
1253:   PetscCall(VecDuplicate(matctx->t,&matctx->Vi));
1254:   if (flg) PetscCall(PetscFree(A));
1255:   PetscFunctionReturn(PETSC_SUCCESS);
1256: }

1258: static PetscErrorCode NRefSubcommDestroy(PEP pep,PEP_REFINE_EXPLICIT *matctx)
1259: {
1260:   PetscInt       i;

1262:   PetscFunctionBegin;
1263:   PetscCall(VecScatterDestroy(&matctx->scatter_sub));
1264:   for (i=0;i<matctx->subc->n;i++) PetscCall(VecScatterDestroy(&matctx->scatter_id[i]));
1265:   for (i=0;i<pep->nmat;i++) PetscCall(MatDestroy(&matctx->A[i]));
1266:   if (pep->scheme==PEP_REFINE_SCHEME_EXPLICIT) {
1267:     for (i=0;i<matctx->subc->n;i++) PetscCall(VecScatterDestroy(&matctx->scatterp_id[i]));
1268:     PetscCall(VecDestroy(&matctx->tp));
1269:     PetscCall(VecDestroy(&matctx->tpg));
1270:     PetscCall(BVDestroy(&matctx->W));
1271:   }
1272:   PetscCall(PetscFree3(matctx->A,matctx->scatter_id,matctx->scatterp_id));
1273:   PetscCall(BVDestroy(&matctx->V));
1274:   PetscCall(VecDestroy(&matctx->t));
1275:   PetscCall(VecDestroy(&matctx->tg));
1276:   PetscCall(VecDestroy(&matctx->Rv));
1277:   PetscCall(VecDestroy(&matctx->Vi));
1278:   PetscFunctionReturn(PETSC_SUCCESS);
1279: }

1281: PetscErrorCode PEPNewtonRefinement_TOAR(PEP pep,PetscScalar sigma,PetscInt *maxits,PetscReal *tol,PetscInt k,PetscScalar *S,PetscInt lds)
1282: {
1283:   PetscScalar         *H,*work,*dH,*fH,*dVS;
1284:   PetscInt            ldh,i,j,its=1,nmat=pep->nmat,nsubc=pep->npart,rds;
1285:   PetscBLASInt        k_,ld_,*p,info;
1286:   BV                  dV;
1287:   PetscBool           sinvert,flg;
1288:   PEP_REFINE_EXPLICIT *matctx=NULL;
1289:   Vec                 v;
1290:   Mat                 M,P;
1291:   PEP_REFINE_MATSHELL *ctx;

1293:   PetscFunctionBegin;
1294:   PetscCall(PetscLogEventBegin(PEP_Refine,pep,0,0,0));
1295:   PetscCheck(k<=pep->n,PetscObjectComm((PetscObject)pep),PETSC_ERR_SUP,"Multiple Refinement available only for invariant pairs of dimension smaller than n=%" PetscInt_FMT,pep->n);
1296:   /* the input tolerance is not being taken into account (by the moment) */
1297:   its = *maxits;
1298:   PetscCall(PetscMalloc3(k*k,&dH,nmat*k*k,&fH,k,&work));
1299:   PetscCall(DSGetLeadingDimension(pep->ds,&ldh));
1300:   PetscCall(PetscMalloc1(2*k*k,&dVS));
1301:   PetscCall(STGetTransform(pep->st,&flg));
1302:   if (!flg && pep->st && pep->ops->backtransform) { /* BackTransform */
1303:     PetscCall(PetscBLASIntCast(k,&k_));
1304:     PetscCall(PetscBLASIntCast(ldh,&ld_));
1305:     PetscCall(PetscObjectTypeCompare((PetscObject)pep->st,STSINVERT,&sinvert));
1306:     if (sinvert) {
1307:       PetscCall(DSGetArray(pep->ds,DS_MAT_A,&H));
1308:       PetscCall(PetscMalloc1(k,&p));
1309:       PetscCall(PetscFPTrapPush(PETSC_FP_TRAP_OFF));
1310:       PetscCallBLAS("LAPACKgetrf",LAPACKgetrf_(&k_,&k_,H,&ld_,p,&info));
1311:       SlepcCheckLapackInfo("getrf",info);
1312:       PetscCallBLAS("LAPACKgetri",LAPACKgetri_(&k_,H,&ld_,p,work,&k_,&info));
1313:       SlepcCheckLapackInfo("getri",info);
1314:       PetscCall(PetscFPTrapPop());
1315:       PetscCall(DSRestoreArray(pep->ds,DS_MAT_A,&H));
1316:       pep->ops->backtransform = NULL;
1317:     }
1318:     if (sigma!=0.0) {
1319:       PetscCall(DSGetArray(pep->ds,DS_MAT_A,&H));
1320:       for (i=0;i<k;i++) H[i+ldh*i] += sigma;
1321:       PetscCall(DSRestoreArray(pep->ds,DS_MAT_A,&H));
1322:       pep->ops->backtransform = NULL;
1323:     }
1324:   }
1325:   if ((pep->scale==PEP_SCALE_BOTH || pep->scale==PEP_SCALE_SCALAR) && pep->sfactor!=1.0) {
1326:     PetscCall(DSGetArray(pep->ds,DS_MAT_A,&H));
1327:     for (j=0;j<k;j++) {
1328:       for (i=0;i<k;i++) H[i+j*ldh] *= pep->sfactor;
1329:     }
1330:     PetscCall(DSRestoreArray(pep->ds,DS_MAT_A,&H));
1331:     if (!flg) {
1332:       /* Restore original values */
1333:       for (i=0;i<pep->nmat;i++) {
1334:         pep->pbc[pep->nmat+i] *= pep->sfactor;
1335:         pep->pbc[2*pep->nmat+i] *= pep->sfactor*pep->sfactor;
1336:       }
1337:     }
1338:   }
1339:   if ((pep->scale==PEP_SCALE_DIAGONAL || pep->scale==PEP_SCALE_BOTH) && pep->Dr) {
1340:     for (i=0;i<k;i++) {
1341:       PetscCall(BVGetColumn(pep->V,i,&v));
1342:       PetscCall(VecPointwiseMult(v,v,pep->Dr));
1343:       PetscCall(BVRestoreColumn(pep->V,i,&v));
1344:     }
1345:   }
1346:   PetscCall(DSGetArray(pep->ds,DS_MAT_A,&H));

1348:   PetscCall(NRefOrthogStep(pep,k,H,ldh,fH,S,lds));
1349:   /* check if H is in Schur form */
1350:   for (i=0;i<k-1;i++) {
1351: #if !defined(PETSC_USE_COMPLEX)
1352:     PetscCheck(H[i+1+i*ldh]==0.0,PetscObjectComm((PetscObject)pep),PETSC_ERR_SUP,"Iterative Refinement requires the complex Schur form of the projected matrix");
1353: #else
1354:     PetscCheck(H[i+1+i*ldh]==0.0,PetscObjectComm((PetscObject)pep),PETSC_ERR_SUP,"Iterative Refinement requires an upper triangular projected matrix");
1355: #endif
1356:   }
1357:   PetscCheck(nsubc<=k,PetscObjectComm((PetscObject)pep),PETSC_ERR_SUP,"Number of subcommunicators should not be larger than the invariant pair dimension");
1358:   PetscCall(BVSetActiveColumns(pep->V,0,k));
1359:   PetscCall(BVDuplicateResize(pep->V,k,&dV));
1360:   if (pep->scheme!=PEP_REFINE_SCHEME_SCHUR) {
1361:     PetscCall(PetscMalloc1(1,&matctx));
1362:     if (nsubc>1) { /* splitting in subcommunicators */
1363:       matctx->subc = pep->refinesubc;
1364:       PetscCall(NRefSubcommSetup(pep,k,matctx,nsubc));
1365:     } else matctx->subc=NULL;
1366:   }

1368:   /* Loop performing iterative refinements */
1369:   for (i=0;i<its;i++) {
1370:     /* Pre-compute the polynomial basis evaluated in H */
1371:     PetscCall(PEPEvaluateBasisforMatrix(pep,nmat,k,H,ldh,fH));
1372:     PetscCall(PEPNRefSetUp(pep,k,H,ldh,matctx,PetscNot(i)));
1373:     /* Solve the linear system */
1374:     PetscCall(PEPNRefForwardSubstitution(pep,k,S,lds,H,ldh,fH,dV,dVS,&rds,dH,k,pep->refineksp,matctx));
1375:     /* Update X (=V*S) and H, and orthogonalize [X;X*fH1;...;XfH(deg-1)] */
1376:     PetscCall(PEPNRefUpdateInvPair(pep,k,H,ldh,fH,dH,S,lds,dV,dVS,rds));
1377:   }
1378:   PetscCall(DSRestoreArray(pep->ds,DS_MAT_A,&H));
1379:   if (!flg && sinvert) PetscCall(PetscFree(p));
1380:   PetscCall(PetscFree3(dH,fH,work));
1381:   PetscCall(PetscFree(dVS));
1382:   PetscCall(BVDestroy(&dV));
1383:   switch (pep->scheme) {
1384:   case PEP_REFINE_SCHEME_EXPLICIT:
1385:     for (i=0;i<2;i++) PetscCall(MatDestroy(&matctx->E[i]));
1386:     PetscCall(PetscFree4(matctx->idxp,matctx->idxg,matctx->map0,matctx->map1));
1387:     PetscCall(VecDestroy(&matctx->tN));
1388:     PetscCall(VecDestroy(&matctx->ttN));
1389:     PetscCall(VecDestroy(&matctx->t1));
1390:     if (nsubc>1) PetscCall(NRefSubcommDestroy(pep,matctx));
1391:     else {
1392:       PetscCall(VecDestroy(&matctx->vseq));
1393:       PetscCall(VecScatterDestroy(&matctx->scatterctx));
1394:     }
1395:     PetscCall(PetscFree(matctx));
1396:     PetscCall(KSPGetOperators(pep->refineksp,&M,NULL));
1397:     PetscCall(MatDestroy(&M));
1398:     break;
1399:   case PEP_REFINE_SCHEME_MBE:
1400:     PetscCall(BVDestroy(&matctx->W));
1401:     PetscCall(BVDestroy(&matctx->Wt));
1402:     PetscCall(BVDestroy(&matctx->M2));
1403:     PetscCall(BVDestroy(&matctx->M3));
1404:     PetscCall(MatDestroy(&matctx->M1));
1405:     PetscCall(VecDestroy(&matctx->t));
1406:     PetscCall(PetscFree5(matctx->M4,matctx->w,matctx->wt,matctx->d,matctx->dt));
1407:     if (nsubc>1) PetscCall(NRefSubcommDestroy(pep,matctx));
1408:     PetscCall(PetscFree(matctx));
1409:     break;
1410:   case PEP_REFINE_SCHEME_SCHUR:
1411:     PetscCall(KSPGetOperators(pep->refineksp,&M,&P));
1412:     PetscCall(MatShellGetContext(M,&ctx));
1413:     PetscCall(PetscFree5(ctx->A,ctx->M4,ctx->pM4,ctx->work,ctx->fih));
1414:     PetscCall(MatDestroy(&ctx->M1));
1415:     PetscCall(BVDestroy(&ctx->M2));
1416:     PetscCall(BVDestroy(&ctx->M3));
1417:     PetscCall(BVDestroy(&ctx->W));
1418:     PetscCall(VecDestroy(&ctx->t));
1419:     PetscCall(PetscFree(ctx));
1420:     PetscCall(MatDestroy(&M));
1421:     PetscCall(MatDestroy(&P));
1422:     break;
1423:   }
1424:   PetscCall(PetscLogEventEnd(PEP_Refine,pep,0,0,0));
1425:   PetscFunctionReturn(PETSC_SUCCESS);
1426: }