Actual source code: nepdefl.c

slepc-3.18.0 2022-10-01
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: */

 11: #include <slepc/private/nepimpl.h>
 12: #include <slepcblaslapack.h>
 13: #include "nepdefl.h"

 15: PetscErrorCode NEPDeflationGetInvariantPair(NEP_EXT_OP extop,BV *X,Mat *H)
 16: {
 17:   if (X) *X = extop->X;
 18:   if (H) MatCreateSeqDense(PETSC_COMM_SELF,extop->szd+1,extop->szd+1,extop->H,H);
 19:   return 0;
 20: }

 22: PetscErrorCode NEPDeflationExtendInvariantPair(NEP_EXT_OP extop,Vec u,PetscScalar lambda,PetscInt k)
 23: {
 24:   Vec            uu;
 25:   PetscInt       ld,i;
 26:   PetscMPIInt    np;
 27:   PetscReal      norm;

 29:   BVGetColumn(extop->X,k,&uu);
 30:   ld = extop->szd+1;
 31:   NEPDeflationCopyToExtendedVec(extop,uu,extop->H+k*ld,u,PETSC_TRUE);
 32:   BVRestoreColumn(extop->X,k,&uu);
 33:   BVNormColumn(extop->X,k,NORM_2,&norm);
 34:   BVScaleColumn(extop->X,k,1.0/norm);
 35:   MPI_Comm_size(PetscObjectComm((PetscObject)u),&np);
 36:   for (i=0;i<k;i++) extop->H[k*ld+i] *= PetscSqrtReal(np)/norm;
 37:   extop->H[k*(ld+1)] = lambda;
 38:   return 0;
 39: }

 41: PetscErrorCode NEPDeflationExtractEigenpair(NEP_EXT_OP extop,PetscInt k,Vec u,PetscScalar lambda,DS ds)
 42: {
 43:   Mat            A,H;
 44:   PetscInt       ldh=extop->szd+1,ldds,k1=k+1;
 45:   PetscScalar    *eigr,*eigi,*t,*Z;
 46:   Vec            x;

 48:   NEPDeflationExtendInvariantPair(extop,u,lambda,k);
 49:   MatCreateSeqDense(PETSC_COMM_SELF,k1,k1,extop->H,&H);
 50:   MatDenseSetLDA(H,ldh);
 51:   PetscCalloc3(k1,&eigr,k1,&eigi,extop->szd,&t);
 52:   DSReset(ds);
 53:   DSSetType(ds,DSNHEP);
 54:   DSAllocate(ds,ldh);
 55:   DSGetLeadingDimension(ds,&ldds);
 56:   DSSetDimensions(ds,k1,0,k1);
 57:   DSGetMat(ds,DS_MAT_A,&A);
 58:   MatCopy(H,A,SAME_NONZERO_PATTERN);
 59:   DSRestoreMat(ds,DS_MAT_A,&A);
 60:   MatDestroy(&H);
 61:   DSSolve(ds,eigr,eigi);
 62:   DSVectors(ds,DS_MAT_X,&k,NULL);
 63:   DSGetArray(ds,DS_MAT_X,&Z);
 64:   BVMultColumn(extop->X,1.0,Z[k*ldds+k],k,Z+k*ldds);
 65:   DSRestoreArray(ds,DS_MAT_X,&Z);
 66:   BVGetColumn(extop->X,k,&x);
 67:   NEPDeflationCopyToExtendedVec(extop,x,t,u,PETSC_FALSE);
 68:   BVRestoreColumn(extop->X,k,&x);
 69:   PetscFree3(eigr,eigi,t);
 70:   return 0;
 71: }

 73: PetscErrorCode NEPDeflationCopyToExtendedVec(NEP_EXT_OP extop,Vec v,PetscScalar *a,Vec vex,PetscBool back)
 74: {
 75:   PetscMPIInt    np,rk,count;
 76:   PetscScalar    *array1,*array2;
 77:   PetscInt       nloc;

 79:   if (extop->szd) {
 80:     MPI_Comm_rank(PetscObjectComm((PetscObject)vex),&rk);
 81:     MPI_Comm_size(PetscObjectComm((PetscObject)vex),&np);
 82:     BVGetSizes(extop->nep->V,&nloc,NULL,NULL);
 83:     if (v) {
 84:       VecGetArray(v,&array1);
 85:       VecGetArray(vex,&array2);
 86:       if (back) PetscArraycpy(array1,array2,nloc);
 87:       else PetscArraycpy(array2,array1,nloc);
 88:       VecRestoreArray(v,&array1);
 89:       VecRestoreArray(vex,&array2);
 90:     }
 91:     if (a) {
 92:       VecGetArray(vex,&array2);
 93:       if (back) {
 94:         PetscArraycpy(a,array2+nloc,extop->szd);
 95:         PetscMPIIntCast(extop->szd,&count);
 96:         MPI_Bcast(a,count,MPIU_SCALAR,np-1,PetscObjectComm((PetscObject)vex));
 97:       } else {
 98:         PetscArraycpy(array2+nloc,a,extop->szd);
 99:         PetscMPIIntCast(extop->szd,&count);
100:         MPI_Bcast(array2+nloc,count,MPIU_SCALAR,np-1,PetscObjectComm((PetscObject)vex));
101:       }
102:       VecRestoreArray(vex,&array2);
103:     }
104:   } else {
105:     if (back) VecCopy(vex,v);
106:     else VecCopy(v,vex);
107:   }
108:   return 0;
109: }

111: PetscErrorCode NEPDeflationCreateVec(NEP_EXT_OP extop,Vec *v)
112: {
113:   PetscInt       nloc;
114:   Vec            u;
115:   VecType        type;

117:   if (extop->szd) {
118:     BVGetColumn(extop->nep->V,0,&u);
119:     VecGetType(u,&type);
120:     BVRestoreColumn(extop->nep->V,0,&u);
121:     VecCreate(PetscObjectComm((PetscObject)extop->nep),v);
122:     VecSetType(*v,type);
123:     BVGetSizes(extop->nep->V,&nloc,NULL,NULL);
124:     nloc += extop->szd;
125:     VecSetSizes(*v,nloc,PETSC_DECIDE);
126:   } else BVCreateVec(extop->nep->V,v);
127:   return 0;
128: }

130: PetscErrorCode NEPDeflationCreateBV(NEP_EXT_OP extop,PetscInt sz,BV *V)
131: {
132:   PetscInt           nloc;
133:   BVType             type;
134:   BVOrthogType       otype;
135:   BVOrthogRefineType oref;
136:   PetscReal          oeta;
137:   BVOrthogBlockType  oblock;
138:   NEP                nep=extop->nep;

140:   if (extop->szd) {
141:     BVGetSizes(nep->V,&nloc,NULL,NULL);
142:     BVCreate(PetscObjectComm((PetscObject)nep),V);
143:     BVSetSizes(*V,nloc+extop->szd,PETSC_DECIDE,sz);
144:     BVGetType(nep->V,&type);
145:     BVSetType(*V,type);
146:     BVGetOrthogonalization(nep->V,&otype,&oref,&oeta,&oblock);
147:     BVSetOrthogonalization(*V,otype,oref,oeta,oblock);
148:     PetscObjectStateIncrease((PetscObject)*V);
149:   } else BVDuplicateResize(nep->V,sz,V);
150:   return 0;
151: }

153: PetscErrorCode NEPDeflationSetRandomVec(NEP_EXT_OP extop,Vec v)
154: {
155:   PetscInt       n,next,i;
156:   PetscRandom    rand;
157:   PetscScalar    *array;
158:   PetscMPIInt    nn,np;

160:   BVGetRandomContext(extop->nep->V,&rand);
161:   VecSetRandom(v,rand);
162:   if (extop->szd) {
163:     MPI_Comm_size(PetscObjectComm((PetscObject)v),&np);
164:     BVGetSizes(extop->nep->V,&n,NULL,NULL);
165:     VecGetLocalSize(v,&next);
166:     VecGetArray(v,&array);
167:     for (i=n+extop->n;i<next;i++) array[i] = 0.0;
168:     for (i=n;i<n+extop->n;i++) array[i] /= PetscSqrtReal(np);
169:     PetscMPIIntCast(extop->n,&nn);
170:     MPI_Bcast(array+n,nn,MPIU_SCALAR,0,PetscObjectComm((PetscObject)v));
171:     VecRestoreArray(v,&array);
172:   }
173:   return 0;
174: }

176: static PetscErrorCode NEPDeflationEvaluateBasisMat(NEP_EXT_OP extop,PetscInt idx,PetscBool hat,PetscScalar *bval,PetscScalar *Hj,PetscScalar *Hjprev)
177: {
178:   PetscInt       i,k,n=extop->n,ldhj=extop->szd,ldh=extop->szd+1;
179:   PetscScalar    sone=1.0,zero=0.0;
180:   PetscBLASInt   ldh_,ldhj_,n_;

182:   i = (idx<0)?extop->szd*extop->szd*(-idx):extop->szd*extop->szd;
183:   PetscArrayzero(Hj,i);
184:   PetscBLASIntCast(ldhj+1,&ldh_);
185:   PetscBLASIntCast(ldhj,&ldhj_);
186:   PetscBLASIntCast(n,&n_);
187:   if (idx<1) {
188:     if (!hat) for (i=0;i<extop->n;i++) Hj[i+i*ldhj] = 1.0;
189:     else for (i=0;i<extop->n;i++) Hj[i+i*ldhj] = 0.0;
190:   } else {
191:       for (i=0;i<n;i++) extop->H[i*ldh+i] -= extop->bc[idx-1];
192:       PetscCallBLAS("BLASgemm",BLASgemm_("N","N",&n_,&n_,&n_,&sone,extop->H,&ldh_,Hjprev,&ldhj_,&zero,Hj,&ldhj_));
193:       for (i=0;i<n;i++) extop->H[i*ldh+i] += extop->bc[idx-1];
194:       if (hat) for (i=0;i<n;i++) Hj[i*(ldhj+1)] += bval[idx-1];
195:   }
196:   if (idx<0) {
197:     idx = -idx;
198:     for (k=1;k<idx;k++) {
199:       for (i=0;i<n;i++) extop->H[i*ldh+i] -= extop->bc[k-1];
200:       PetscCallBLAS("BLASgemm",BLASgemm_("N","N",&n_,&n_,&n_,&sone,extop->H,&ldh_,Hj+(k-1)*ldhj*ldhj,&ldhj_,&zero,Hj+k*ldhj*ldhj,&ldhj_));
201:       for (i=0;i<n;i++) extop->H[i*ldh+i] += extop->bc[k-1];
202:       if (hat) for (i=0;i<n;i++) Hj[i*(ldhj+1)] += bval[k-1];
203:     }
204:   }
205:   return 0;
206: }

208: PetscErrorCode NEPDeflationLocking(NEP_EXT_OP extop,Vec u,PetscScalar lambda)
209: {
210:   PetscInt       i;

212:   NEPDeflationExtendInvariantPair(extop,u,lambda,extop->n);
213:   extop->n++;
214:   BVSetActiveColumns(extop->X,0,extop->n);
215:   if (extop->n <= extop->szd) {
216:     /* update XpX */
217:     BVDotColumn(extop->X,extop->n-1,extop->XpX+(extop->n-1)*extop->szd);
218:     extop->XpX[(extop->n-1)*(1+extop->szd)] = 1.0;
219:     for (i=0;i<extop->n-1;i++) extop->XpX[i*extop->szd+extop->n-1] = PetscConj(extop->XpX[(extop->n-1)*extop->szd+i]);
220:     /* determine minimality index */
221:     extop->midx = PetscMin(extop->max_midx,extop->n);
222:     /* polynominal basis coefficients */
223:     for (i=0;i<extop->midx;i++) extop->bc[i] = extop->nep->target;
224:     /* evaluate the polynomial basis in H */
225:     NEPDeflationEvaluateBasisMat(extop,-extop->midx,PETSC_FALSE,NULL,extop->Hj,NULL);
226:   }
227:   return 0;
228: }

230: static PetscErrorCode NEPDeflationEvaluateHatFunction(NEP_EXT_OP extop, PetscInt idx,PetscScalar lambda,PetscScalar *y,PetscScalar *hfj,PetscScalar *hfjp,PetscInt ld)
231: {
232:   PetscInt          i,j,k,off,ini,fin,sz,ldh,n=extop->n;
233:   Mat               A,B;
234:   PetscScalar       *array;
235:   const PetscScalar *barray;

237:   if (idx<0) {ini = 0; fin = extop->nep->nt;}
238:   else {ini = idx; fin = idx+1;}
239:   if (y) sz = hfjp?n+2:n+1;
240:   else sz = hfjp?3*n:2*n;
241:   ldh = extop->szd+1;
242:   MatCreateSeqDense(PETSC_COMM_SELF,sz,sz,NULL,&A);
243:   MatCreateSeqDense(PETSC_COMM_SELF,sz,sz,NULL,&B);
244:   MatDenseGetArray(A,&array);
245:   for (j=0;j<n;j++)
246:     for (i=0;i<n;i++) array[j*sz+i] = extop->H[j*ldh+i];
247:   MatDenseRestoreArrayWrite(A,&array);
248:   if (y) {
249:     MatDenseGetArray(A,&array);
250:     array[extop->n*(sz+1)] = lambda;
251:     if (hfjp) { array[(n+1)*sz+n] = 1.0; array[(n+1)*sz+n+1] = lambda;}
252:     for (i=0;i<n;i++) array[n*sz+i] = y[i];
253:     MatDenseRestoreArrayWrite(A,&array);
254:     for (j=ini;j<fin;j++) {
255:       FNEvaluateFunctionMat(extop->nep->f[j],A,B);
256:       MatDenseGetArrayRead(B,&barray);
257:       for (i=0;i<n;i++) hfj[j*ld+i] = barray[n*sz+i];
258:       if (hfjp) for (i=0;i<n;i++) hfjp[j*ld+i] = barray[(n+1)*sz+i];
259:       MatDenseRestoreArrayRead(B,&barray);
260:     }
261:   } else {
262:     off = idx<0?ld*n:0;
263:     MatDenseGetArray(A,&array);
264:     for (k=0;k<n;k++) {
265:       array[(n+k)*sz+k] = 1.0;
266:       array[(n+k)*sz+n+k] = lambda;
267:     }
268:     if (hfjp) for (k=0;k<n;k++) {
269:       array[(2*n+k)*sz+n+k] = 1.0;
270:       array[(2*n+k)*sz+2*n+k] = lambda;
271:     }
272:     MatDenseRestoreArray(A,&array);
273:     for (j=ini;j<fin;j++) {
274:       FNEvaluateFunctionMat(extop->nep->f[j],A,B);
275:       MatDenseGetArrayRead(B,&barray);
276:       for (i=0;i<n;i++) for (k=0;k<n;k++) hfj[j*off+i*ld+k] = barray[n*sz+i*sz+k];
277:       if (hfjp) for (k=0;k<n;k++) for (i=0;i<n;i++) hfjp[j*off+i*ld+k] = barray[2*n*sz+i*sz+k];
278:       MatDenseRestoreArrayRead(B,&barray);
279:     }
280:   }
281:   MatDestroy(&A);
282:   MatDestroy(&B);
283:   return 0;
284: }

286: static PetscErrorCode MatMult_NEPDeflation(Mat M,Vec x,Vec y)
287: {
288:   NEP_DEF_MATSHELL  *matctx;
289:   NEP_EXT_OP        extop;
290:   Vec               x1,y1;
291:   PetscScalar       *yy,sone=1.0,zero=0.0;
292:   const PetscScalar *xx;
293:   PetscInt          nloc,i;
294:   PetscMPIInt       np;
295:   PetscBLASInt      n_,one=1,szd_;

297:   MPI_Comm_size(PetscObjectComm((PetscObject)M),&np);
298:   MatShellGetContext(M,&matctx);
299:   extop = matctx->extop;
300:   if (extop->ref) VecZeroEntries(y);
301:   if (extop->szd) {
302:     x1 = matctx->w[0]; y1 = matctx->w[1];
303:     VecGetArrayRead(x,&xx);
304:     VecPlaceArray(x1,xx);
305:     VecGetArray(y,&yy);
306:     VecPlaceArray(y1,yy);
307:     MatMult(matctx->T,x1,y1);
308:     if (!extop->ref && extop->n) {
309:       VecGetLocalSize(x1,&nloc);
310:       /* copy for avoiding warning of constant array xx */
311:       for (i=0;i<extop->n;i++) matctx->work[i] = xx[nloc+i]*PetscSqrtReal(np);
312:       BVMultVec(matctx->U,1.0,1.0,y1,matctx->work);
313:       BVDotVec(extop->X,x1,matctx->work);
314:       PetscBLASIntCast(extop->n,&n_);
315:       PetscBLASIntCast(extop->szd,&szd_);
316:       PetscCallBLAS("BLASgemv",BLASgemv_("N",&n_,&n_,&sone,matctx->A,&szd_,matctx->work,&one,&zero,yy+nloc,&one));
317:       PetscCallBLAS("BLASgemv",BLASgemv_("N",&n_,&n_,&sone,matctx->B,&szd_,xx+nloc,&one,&sone,yy+nloc,&one));
318:       for (i=0;i<extop->n;i++) yy[nloc+i] /= PetscSqrtReal(np);
319:     }
320:     VecResetArray(x1);
321:     VecRestoreArrayRead(x,&xx);
322:     VecResetArray(y1);
323:     VecRestoreArray(y,&yy);
324:   } else MatMult(matctx->T,x,y);
325:   return 0;
326: }

328: static PetscErrorCode MatCreateVecs_NEPDeflation(Mat M,Vec *right,Vec *left)
329: {
330:   NEP_DEF_MATSHELL *matctx;

332:   MatShellGetContext(M,&matctx);
333:   if (right) VecDuplicate(matctx->w[0],right);
334:   if (left) VecDuplicate(matctx->w[0],left);
335:   return 0;
336: }

338: static PetscErrorCode MatDestroy_NEPDeflation(Mat M)
339: {
340:   NEP_DEF_MATSHELL *matctx;

342:   MatShellGetContext(M,&matctx);
343:   if (matctx->extop->szd) {
344:     BVDestroy(&matctx->U);
345:     PetscFree2(matctx->hfj,matctx->work);
346:     PetscFree2(matctx->A,matctx->B);
347:     VecDestroy(&matctx->w[0]);
348:     VecDestroy(&matctx->w[1]);
349:   }
350:   if (matctx->P != matctx->T) MatDestroy(&matctx->P);
351:   MatDestroy(&matctx->T);
352:   PetscFree(matctx);
353:   return 0;
354: }

356: static PetscErrorCode NEPDeflationEvaluateBasis(NEP_EXT_OP extop,PetscScalar lambda,PetscInt n,PetscScalar *val,PetscBool jacobian)
357: {
358:   PetscScalar p;
359:   PetscInt    i;

361:   if (!jacobian) {
362:     val[0] = 1.0;
363:     for (i=1;i<extop->n;i++) val[i] = val[i-1]*(lambda-extop->bc[i-1]);
364:   } else {
365:     val[0] = 0.0;
366:     p = 1.0;
367:     for (i=1;i<extop->n;i++) {
368:       val[i] = val[i-1]*(lambda-extop->bc[i-1])+p;
369:       p *= (lambda-extop->bc[i-1]);
370:     }
371:   }
372:   return 0;
373: }

375: static PetscErrorCode NEPDeflationComputeShellMat(NEP_EXT_OP extop,PetscScalar lambda,PetscBool jacobian,Mat *M)
376: {
377:   NEP_DEF_MATSHELL *matctx,*matctxC;
378:   PetscInt         nloc,mloc,n=extop->n,j,i,szd=extop->szd,ldh=szd+1,k;
379:   Mat              F,Mshell,Mcomp;
380:   PetscBool        ini=PETSC_FALSE;
381:   PetscScalar      *hf,*hfj,*hfjp,sone=1.0,*hH,*hHprev,*pts,*B,*A,*Hj=extop->Hj,*basisv,zero=0.0;
382:   PetscBLASInt     n_,info,szd_;

384:   if (!M) Mshell = jacobian?extop->MJ:extop->MF;
385:   else Mshell = *M;
386:   Mcomp = jacobian?extop->MF:extop->MJ;
387:   if (!Mshell) {
388:     ini = PETSC_TRUE;
389:     PetscNew(&matctx);
390:     MatGetLocalSize(extop->nep->function,&mloc,&nloc);
391:     nloc += szd; mloc += szd;
392:     MatCreateShell(PetscObjectComm((PetscObject)extop->nep),nloc,mloc,PETSC_DETERMINE,PETSC_DETERMINE,matctx,&Mshell);
393:     MatShellSetOperation(Mshell,MATOP_MULT,(void(*)(void))MatMult_NEPDeflation);
394:     MatShellSetOperation(Mshell,MATOP_CREATE_VECS,(void(*)(void))MatCreateVecs_NEPDeflation);
395:     MatShellSetOperation(Mshell,MATOP_DESTROY,(void(*)(void))MatDestroy_NEPDeflation);
396:     matctx->nep = extop->nep;
397:     matctx->extop = extop;
398:     if (!M) {
399:       if (jacobian) { matctx->jacob = PETSC_TRUE; matctx->T = extop->nep->jacobian; extop->MJ = Mshell; }
400:       else { matctx->jacob = PETSC_FALSE; matctx->T = extop->nep->function; extop->MF = Mshell; }
401:       PetscObjectReference((PetscObject)matctx->T);
402:       if (!jacobian) {
403:         if (extop->nep->function_pre && extop->nep->function_pre != extop->nep->function) {
404:           matctx->P = extop->nep->function_pre;
405:           PetscObjectReference((PetscObject)matctx->P);
406:         } else matctx->P = matctx->T;
407:       }
408:     } else {
409:       matctx->jacob = jacobian;
410:       MatDuplicate(jacobian?extop->nep->jacobian:extop->nep->function,MAT_DO_NOT_COPY_VALUES,&matctx->T);
411:       *M = Mshell;
412:       if (!jacobian) {
413:         if (extop->nep->function_pre && extop->nep->function_pre != extop->nep->function) MatDuplicate(extop->nep->function_pre,MAT_DO_NOT_COPY_VALUES,&matctx->P);
414:         else matctx->P = matctx->T;
415:       }
416:     }
417:     if (szd) {
418:       BVCreateVec(extop->nep->V,matctx->w);
419:       VecDuplicate(matctx->w[0],matctx->w+1);
420:       BVDuplicateResize(extop->nep->V,szd,&matctx->U);
421:       PetscMalloc2(extop->simpU?2*(szd)*(szd):2*(szd)*(szd)*extop->nep->nt,&matctx->hfj,szd,&matctx->work);
422:       PetscMalloc2(szd*szd,&matctx->A,szd*szd,&matctx->B);
423:     }
424:   } else MatShellGetContext(Mshell,&matctx);
425:   if (ini || matctx->theta != lambda || matctx->n != extop->n) {
426:     if (ini || matctx->theta != lambda) {
427:       if (jacobian) NEPComputeJacobian(extop->nep,lambda,matctx->T);
428:       else NEPComputeFunction(extop->nep,lambda,matctx->T,matctx->P);
429:     }
430:     if (n) {
431:       matctx->hfjset = PETSC_FALSE;
432:       if (!extop->simpU) {
433:         /* likely hfjp has been already computed */
434:         if (Mcomp) {
435:           MatShellGetContext(Mcomp,&matctxC);
436:           if (matctxC->hfjset && matctxC->theta == lambda && matctxC->n == extop->n) {
437:             PetscArraycpy(matctx->hfj,matctxC->hfj,2*extop->szd*extop->szd*extop->nep->nt);
438:             matctx->hfjset = PETSC_TRUE;
439:           }
440:         }
441:         hfj = matctx->hfj; hfjp = matctx->hfj+extop->szd*extop->szd*extop->nep->nt;
442:         if (!matctx->hfjset) {
443:           NEPDeflationEvaluateHatFunction(extop,-1,lambda,NULL,hfj,hfjp,n);
444:           matctx->hfjset = PETSC_TRUE;
445:         }
446:         BVSetActiveColumns(matctx->U,0,n);
447:         hf = jacobian?hfjp:hfj;
448:         MatCreateSeqDense(PETSC_COMM_SELF,n,n,hf,&F);
449:         BVMatMult(extop->X,extop->nep->A[0],matctx->U);
450:         BVMultInPlace(matctx->U,F,0,n);
451:         BVSetActiveColumns(extop->W,0,extop->n);
452:         for (j=1;j<extop->nep->nt;j++) {
453:           BVMatMult(extop->X,extop->nep->A[j],extop->W);
454:           MatDensePlaceArray(F,hf+j*n*n);
455:           BVMult(matctx->U,1.0,1.0,extop->W,F);
456:           MatDenseResetArray(F);
457:         }
458:         MatDestroy(&F);
459:       } else {
460:         hfj = matctx->hfj;
461:         BVSetActiveColumns(matctx->U,0,n);
462:         BVMatMult(extop->X,matctx->T,matctx->U);
463:         for (j=0;j<n;j++) {
464:           for (i=0;i<n;i++) hfj[j*n+i] = -extop->H[j*ldh+i];
465:           hfj[j*(n+1)] += lambda;
466:         }
467:         PetscBLASIntCast(n,&n_);
468:         PetscFPTrapPush(PETSC_FP_TRAP_OFF);
469:         PetscCallBLAS("LAPACKtrtri",LAPACKtrtri_("U","N",&n_,hfj,&n_,&info));
470:         PetscFPTrapPop();
471:         SlepcCheckLapackInfo("trtri",info);
472:         MatCreateSeqDense(PETSC_COMM_SELF,n,n,hfj,&F);
473:         BVMultInPlace(matctx->U,F,0,n);
474:         if (jacobian) {
475:           NEPDeflationComputeFunction(extop,lambda,NULL);
476:           MatShellGetContext(extop->MF,&matctxC);
477:           BVMult(matctx->U,-1.0,1.0,matctxC->U,F);
478:         }
479:         MatDestroy(&F);
480:       }
481:       PetscCalloc3(n,&basisv,szd*szd,&hH,szd*szd,&hHprev);
482:       NEPDeflationEvaluateBasis(extop,lambda,n,basisv,jacobian);
483:       A = matctx->A;
484:       PetscArrayzero(A,szd*szd);
485:       if (!jacobian) for (i=0;i<n;i++) A[i*(szd+1)] = 1.0;
486:       for (j=0;j<n;j++)
487:         for (i=0;i<n;i++)
488:           for (k=1;k<extop->midx;k++) A[j*szd+i] += basisv[k]*PetscConj(Hj[k*szd*szd+i*szd+j]);
489:       PetscBLASIntCast(n,&n_);
490:       PetscBLASIntCast(szd,&szd_);
491:       B = matctx->B;
492:       PetscArrayzero(B,szd*szd);
493:       for (i=1;i<extop->midx;i++) {
494:         NEPDeflationEvaluateBasisMat(extop,i,PETSC_TRUE,basisv,hH,hHprev);
495:         PetscCallBLAS("BLASgemm",BLASgemm_("N","N",&n_,&n_,&n_,&sone,extop->XpX,&szd_,hH,&szd_,&zero,hHprev,&szd_));
496:         PetscCallBLAS("BLASgemm",BLASgemm_("C","N",&n_,&n_,&n_,&sone,extop->Hj+szd*szd*i,&szd_,hHprev,&szd_,&sone,B,&szd_));
497:         pts = hHprev; hHprev = hH; hH = pts;
498:       }
499:       PetscFree3(basisv,hH,hHprev);
500:     }
501:     matctx->theta = lambda;
502:     matctx->n = extop->n;
503:   }
504:   return 0;
505: }

507: PetscErrorCode NEPDeflationComputeFunction(NEP_EXT_OP extop,PetscScalar lambda,Mat *F)
508: {
509:   NEPDeflationComputeShellMat(extop,lambda,PETSC_FALSE,NULL);
510:   if (F) *F = extop->MF;
511:   return 0;
512: }

514: PetscErrorCode NEPDeflationComputeJacobian(NEP_EXT_OP extop,PetscScalar lambda,Mat *J)
515: {
516:   NEPDeflationComputeShellMat(extop,lambda,PETSC_TRUE,NULL);
517:   if (J) *J = extop->MJ;
518:   return 0;
519: }

521: PetscErrorCode NEPDeflationSolveSetUp(NEP_EXT_OP extop,PetscScalar lambda)
522: {
523:   NEP_DEF_MATSHELL  *matctx;
524:   NEP_DEF_FUN_SOLVE solve;
525:   PetscInt          i,j,n=extop->n;
526:   Vec               u,tu;
527:   Mat               F;
528:   PetscScalar       snone=-1.0,sone=1.0;
529:   PetscBLASInt      n_,szd_,ldh_,*p,info;
530:   Mat               Mshell;

532:   solve = extop->solve;
533:   if (lambda!=solve->theta || n!=solve->n) {
534:     NEPDeflationComputeShellMat(extop,lambda,PETSC_FALSE,solve->sincf?NULL:&solve->T);
535:     Mshell = (solve->sincf)?extop->MF:solve->T;
536:     MatShellGetContext(Mshell,&matctx);
537:     NEP_KSPSetOperators(solve->ksp,matctx->T,matctx->P);
538:     if (!extop->ref && n) {
539:       PetscBLASIntCast(n,&n_);
540:       PetscBLASIntCast(extop->szd,&szd_);
541:       PetscBLASIntCast(extop->szd+1,&ldh_);
542:       if (!extop->simpU) {
543:         BVSetActiveColumns(solve->T_1U,0,n);
544:         for (i=0;i<n;i++) {
545:           BVGetColumn(matctx->U,i,&u);
546:           BVGetColumn(solve->T_1U,i,&tu);
547:           KSPSolve(solve->ksp,u,tu);
548:           BVRestoreColumn(solve->T_1U,i,&tu);
549:           BVRestoreColumn(matctx->U,i,&u);
550:         }
551:         MatCreateSeqDense(PETSC_COMM_SELF,n,n,solve->work,&F);
552:         BVDot(solve->T_1U,extop->X,F);
553:         MatDestroy(&F);
554:       } else {
555:         for (j=0;j<n;j++)
556:           for (i=0;i<n;i++) solve->work[j*n+i] = extop->XpX[j*extop->szd+i];
557:         for (i=0;i<n;i++) extop->H[i*ldh_+i] -= lambda;
558:         PetscCallBLAS("BLAStrsm",BLAStrsm_("R","U","N","N",&n_,&n_,&snone,extop->H,&ldh_,solve->work,&n_));
559:         for (i=0;i<n;i++) extop->H[i*ldh_+i] += lambda;
560:       }
561:       PetscArraycpy(solve->M,matctx->B,extop->szd*extop->szd);
562:       PetscCallBLAS("BLASgemm",BLASgemm_("N","N",&n_,&n_,&n_,&snone,matctx->A,&szd_,solve->work,&n_,&sone,solve->M,&szd_));
563:       PetscMalloc1(n,&p);
564:       PetscFPTrapPush(PETSC_FP_TRAP_OFF);
565:       PetscCallBLAS("LAPACKgetrf",LAPACKgetrf_(&n_,&n_,solve->M,&szd_,p,&info));
566:       SlepcCheckLapackInfo("getrf",info);
567:       PetscCallBLAS("LAPACKgetri",LAPACKgetri_(&n_,solve->M,&szd_,p,solve->work,&n_,&info));
568:       SlepcCheckLapackInfo("getri",info);
569:       PetscFPTrapPop();
570:       PetscFree(p);
571:     }
572:     solve->theta = lambda;
573:     solve->n = n;
574:   }
575:   return 0;
576: }

578: PetscErrorCode NEPDeflationFunctionSolve(NEP_EXT_OP extop,Vec b,Vec x)
579: {
580:   Vec               b1,x1;
581:   PetscScalar       *xx,*bb,*x2,*b2,*w,*w2,snone=-1.0,sone=1.0,zero=0.0;
582:   NEP_DEF_MATSHELL  *matctx;
583:   NEP_DEF_FUN_SOLVE solve=extop->solve;
584:   PetscBLASInt      one=1,szd_,n_,ldh_;
585:   PetscInt          nloc,i;
586:   PetscMPIInt       np,count;

588:   if (extop->ref) VecZeroEntries(x);
589:   if (extop->szd) {
590:     x1 = solve->w[0]; b1 = solve->w[1];
591:     VecGetArray(x,&xx);
592:     VecPlaceArray(x1,xx);
593:     VecGetArray(b,&bb);
594:     VecPlaceArray(b1,bb);
595:   } else {
596:     b1 = b; x1 = x;
597:   }
598:   KSPSolve(extop->solve->ksp,b1,x1);
599:   if (!extop->ref && extop->n && extop->szd) {
600:     PetscBLASIntCast(extop->szd,&szd_);
601:     PetscBLASIntCast(extop->n,&n_);
602:     PetscBLASIntCast(extop->szd+1,&ldh_);
603:     BVGetSizes(extop->nep->V,&nloc,NULL,NULL);
604:     PetscMalloc2(extop->n,&b2,extop->n,&x2);
605:     MPI_Comm_size(PetscObjectComm((PetscObject)b),&np);
606:     for (i=0;i<extop->n;i++) b2[i] = bb[nloc+i]*PetscSqrtReal(np);
607:     w = solve->work; w2 = solve->work+extop->n;
608:     MatShellGetContext(solve->sincf?extop->MF:solve->T,&matctx);
609:     PetscArraycpy(w2,b2,extop->n);
610:     BVDotVec(extop->X,x1,w);
611:     PetscCallBLAS("BLASgemv",BLASgemv_("N",&n_,&n_,&snone,matctx->A,&szd_,w,&one,&sone,w2,&one));
612:     PetscCallBLAS("BLASgemv",BLASgemv_("N",&n_,&n_,&sone,solve->M,&szd_,w2,&one,&zero,x2,&one));
613:     if (extop->simpU) {
614:       for (i=0;i<extop->n;i++) extop->H[i+i*(extop->szd+1)] -= solve->theta;
615:       for (i=0;i<extop->n;i++) w[i] = x2[i];
616:       PetscCallBLAS("BLAStrsm",BLAStrsm_("L","U","N","N",&n_,&one,&snone,extop->H,&ldh_,w,&n_));
617:       for (i=0;i<extop->n;i++) extop->H[i+i*(extop->szd+1)] += solve->theta;
618:       BVMultVec(extop->X,-1.0,1.0,x1,w);
619:     } else BVMultVec(solve->T_1U,-1.0,1.0,x1,x2);
620:     for (i=0;i<extop->n;i++) xx[i+nloc] = x2[i]/PetscSqrtReal(np);
621:     PetscMPIIntCast(extop->n,&count);
622:     MPI_Bcast(xx+nloc,count,MPIU_SCALAR,np-1,PetscObjectComm((PetscObject)b));
623:   }
624:   if (extop->szd) {
625:     VecResetArray(x1);
626:     VecRestoreArray(x,&xx);
627:     VecResetArray(b1);
628:     VecRestoreArray(b,&bb);
629:     if (!extop->ref && extop->n) PetscFree2(b2,x2);
630:   }
631:   return 0;
632: }

634: PetscErrorCode NEPDeflationSetRefine(NEP_EXT_OP extop,PetscBool ref)
635: {
636:   extop->ref = ref;
637:   return 0;
638: }

640: PetscErrorCode NEPDeflationReset(NEP_EXT_OP extop)
641: {
642:   PetscInt          j;
643:   NEP_DEF_FUN_SOLVE solve;

645:   if (!extop) return 0;
646:   PetscFree(extop->H);
647:   BVDestroy(&extop->X);
648:   if (extop->szd) {
649:     VecDestroy(&extop->w);
650:     PetscFree3(extop->Hj,extop->XpX,extop->bc);
651:     BVDestroy(&extop->W);
652:   }
653:   MatDestroy(&extop->MF);
654:   MatDestroy(&extop->MJ);
655:   if (extop->solve) {
656:     solve = extop->solve;
657:     if (extop->szd) {
658:       if (!extop->simpU) BVDestroy(&solve->T_1U);
659:       PetscFree2(solve->M,solve->work);
660:       VecDestroy(&solve->w[0]);
661:       VecDestroy(&solve->w[1]);
662:     }
663:     if (!solve->sincf) MatDestroy(&solve->T);
664:     PetscFree(extop->solve);
665:   }
666:   if (extop->proj) {
667:     if (extop->szd) {
668:       for (j=0;j<extop->nep->nt;j++) MatDestroy(&extop->proj->V1pApX[j]);
669:       MatDestroy(&extop->proj->XpV1);
670:       PetscFree3(extop->proj->V2,extop->proj->V1pApX,extop->proj->work);
671:       VecDestroy(&extop->proj->w);
672:       BVDestroy(&extop->proj->V1);
673:     }
674:     PetscFree(extop->proj);
675:   }
676:   PetscFree(extop);
677:   return 0;
678: }

680: PetscErrorCode NEPDeflationInitialize(NEP nep,BV X,KSP ksp,PetscBool sincfun,PetscInt sz,NEP_EXT_OP *extop)
681: {
682:   NEP_EXT_OP        op;
683:   NEP_DEF_FUN_SOLVE solve;
684:   PetscInt          szd;
685:   Vec               x;

687:   NEPDeflationReset(*extop);
688:   PetscNew(&op);
689:   *extop  = op;
690:   op->nep = nep;
691:   op->n   = 0;
692:   op->szd = szd = sz-1;
693:   op->max_midx = PetscMin(MAX_MINIDX,szd);
694:   op->X = X;
695:   if (!X) BVDuplicateResize(nep->V,sz,&op->X);
696:   else PetscObjectReference((PetscObject)X);
697:   PetscCalloc1(sz*sz,&(op)->H);
698:   if (op->szd) {
699:     BVGetColumn(op->X,0,&x);
700:     VecDuplicate(x,&op->w);
701:     BVRestoreColumn(op->X,0,&x);
702:     op->simpU = PETSC_FALSE;
703:     if (nep->fui==NEP_USER_INTERFACE_SPLIT) {
704:       /* undocumented option to use the simple expression for U = T*X*inv(lambda-H) */
705:       PetscOptionsGetBool(NULL,NULL,"-nep_deflation_simpleu",&op->simpU,NULL);
706:     } else {
707:       op->simpU = PETSC_TRUE;
708:     }
709:     PetscCalloc3(szd*szd*op->max_midx,&(op)->Hj,szd*szd,&(op)->XpX,szd,&op->bc);
710:     BVDuplicateResize(op->X,op->szd,&op->W);
711:   }
712:   if (ksp) {
713:     PetscNew(&solve);
714:     op->solve    = solve;
715:     solve->ksp   = ksp;
716:     solve->sincf = sincfun;
717:     solve->n     = -1;
718:     if (op->szd) {
719:       if (!op->simpU) BVDuplicateResize(nep->V,szd,&solve->T_1U);
720:       PetscMalloc2(szd*szd,&solve->M,2*szd*szd,&solve->work);
721:       BVCreateVec(nep->V,&solve->w[0]);
722:       VecDuplicate(solve->w[0],&solve->w[1]);
723:     }
724:   }
725:   return 0;
726: }

728: PetscErrorCode NEPDeflationDSNEPComputeMatrix(DS ds,PetscScalar lambda,PetscBool deriv,DSMatType mat,void *ctx)
729: {
730:   Mat               A,Ei;
731:   PetscScalar       *T,*w1,*w2,*w=NULL,*ww,*hH,*hHprev,*pts;
732:   PetscScalar       alpha,alpha2,*AB,sone=1.0,zero=0.0,*basisv,s;
733:   const PetscScalar *E;
734:   PetscInt          i,ldds,nwork=0,szd,nv,j,k,n;
735:   PetscBLASInt      inc=1,nv_,ldds_,dim_,szdk,szd_,n_,ldh_;
736:   PetscMPIInt       np;
737:   NEP_DEF_PROJECT   proj=(NEP_DEF_PROJECT)ctx;
738:   NEP_EXT_OP        extop=proj->extop;
739:   NEP               nep=extop->nep;

741:   DSGetDimensions(ds,&nv,NULL,NULL,NULL);
742:   DSGetLeadingDimension(ds,&ldds);
743:   DSGetMat(ds,mat,&A);
744:   MatZeroEntries(A);
745:   /* mat = V1^*T(lambda)V1 */
746:   for (i=0;i<nep->nt;i++) {
747:     if (deriv) FNEvaluateDerivative(nep->f[i],lambda,&alpha);
748:     else FNEvaluateFunction(nep->f[i],lambda,&alpha);
749:     DSGetMat(ds,DSMatExtra[i],&Ei);
750:     MatAXPY(A,alpha,Ei,SAME_NONZERO_PATTERN);
751:     DSRestoreMat(ds,DSMatExtra[i],&Ei);
752:   }
753:   DSRestoreMat(ds,mat,&A);
754:   if (!extop->ref && extop->n) {
755:     DSGetArray(ds,mat,&T);
756:     n = extop->n;
757:     szd = extop->szd;
758:     PetscArrayzero(proj->work,proj->lwork);
759:     PetscBLASIntCast(nv,&nv_);
760:     PetscBLASIntCast(n,&n_);
761:     PetscBLASIntCast(ldds,&ldds_);
762:     PetscBLASIntCast(szd,&szd_);
763:     PetscBLASIntCast(proj->dim,&dim_);
764:     PetscBLASIntCast(extop->szd+1,&ldh_);
765:     w1 = proj->work; w2 = proj->work+proj->dim*proj->dim;
766:     nwork += 2*proj->dim*proj->dim;

768:     /* mat = mat + V1^*U(lambda)V2 */
769:     for (i=0;i<nep->nt;i++) {
770:       if (extop->simpU) {
771:         if (deriv) FNEvaluateDerivative(nep->f[i],lambda,&alpha);
772:         else FNEvaluateFunction(nep->f[i],lambda,&alpha);
773:         ww = w1; w = w2;
774:         PetscArraycpy(ww,proj->V2,szd*nv);
775:         MPI_Comm_size(PetscObjectComm((PetscObject)ds),&np);
776:         for (j=0;j<szd*nv;j++) ww[j] *= PetscSqrtReal(np);
777:         for (j=0;j<n;j++) extop->H[j*ldh_+j] -= lambda;
778:         alpha = -alpha;
779:         PetscCallBLAS("BLAStrsm",BLAStrsm_("L","U","N","N",&n_,&nv_,&alpha,extop->H,&ldh_,ww,&szd_));
780:         if (deriv) {
781:           PetscBLASIntCast(szd*nv,&szdk);
782:           FNEvaluateFunction(nep->f[i],lambda,&alpha2);
783:           PetscArraycpy(w,proj->V2,szd*nv);
784:           for (j=0;j<szd*nv;j++) w[j] *= PetscSqrtReal(np);
785:           alpha2 = -alpha2;
786:           PetscCallBLAS("BLAStrsm",BLAStrsm_("L","U","N","N",&n_,&nv_,&alpha2,extop->H,&ldh_,w,&szd_));
787:           alpha2 = 1.0;
788:           PetscCallBLAS("BLAStrsm",BLAStrsm_("L","U","N","N",&n_,&nv_,&alpha2,extop->H,&ldh_,w,&szd_));
789:           PetscCallBLAS("BLASaxpy",BLASaxpy_(&szdk,&sone,w,&inc,ww,&inc));
790:         }
791:         for (j=0;j<n;j++) extop->H[j*ldh_+j] += lambda;
792:       } else {
793:         NEPDeflationEvaluateHatFunction(extop,i,lambda,NULL,w1,w2,szd);
794:         w = deriv?w2:w1; ww = deriv?w1:w2;
795:         MPI_Comm_size(PetscObjectComm((PetscObject)ds),&np);
796:         s = PetscSqrtReal(np);
797:         PetscCallBLAS("BLASgemm",BLASgemm_("N","N",&n_,&nv_,&n_,&s,w,&szd_,proj->V2,&szd_,&zero,ww,&szd_));
798:       }
799:       MatDenseGetArrayRead(proj->V1pApX[i],&E);
800:       PetscCallBLAS("BLASgemm",BLASgemm_("N","N",&nv_,&nv_,&n_,&sone,E,&dim_,ww,&szd_,&sone,T,&ldds_));
801:       MatDenseRestoreArrayRead(proj->V1pApX[i],&E);
802:     }

804:     /* mat = mat + V2^*A(lambda)V1 */
805:     basisv = proj->work+nwork; nwork += szd;
806:     hH     = proj->work+nwork; nwork += szd*szd;
807:     hHprev = proj->work+nwork; nwork += szd*szd;
808:     AB     = proj->work+nwork;
809:     NEPDeflationEvaluateBasis(extop,lambda,n,basisv,deriv);
810:     if (!deriv) for (i=0;i<n;i++) AB[i*(szd+1)] = 1.0;
811:     for (j=0;j<n;j++)
812:       for (i=0;i<n;i++)
813:         for (k=1;k<extop->midx;k++) AB[j*szd+i] += basisv[k]*PetscConj(extop->Hj[k*szd*szd+i*szd+j]);
814:     MatDenseGetArrayRead(proj->XpV1,&E);
815:     PetscCallBLAS("BLASgemm",BLASgemm_("N","N",&n_,&nv_,&n_,&sone,AB,&szd_,E,&szd_,&zero,w,&szd_));
816:     PetscCallBLAS("BLASgemm",BLASgemm_("C","N",&nv_,&nv_,&n_,&sone,proj->V2,&szd_,w,&szd_,&sone,T,&ldds_));
817:     MatDenseRestoreArrayRead(proj->XpV1,&E);

819:     /* mat = mat + V2^*B(lambda)V2 */
820:     PetscArrayzero(AB,szd*szd);
821:     for (i=1;i<extop->midx;i++) {
822:       NEPDeflationEvaluateBasisMat(extop,i,PETSC_TRUE,basisv,hH,hHprev);
823:       PetscCallBLAS("BLASgemm",BLASgemm_("N","N",&n_,&n_,&n_,&sone,extop->XpX,&szd_,hH,&szd_,&zero,hHprev,&szd_));
824:       PetscCallBLAS("BLASgemm",BLASgemm_("C","N",&n_,&n_,&n_,&sone,extop->Hj+szd*szd*i,&szd_,hHprev,&szd_,&sone,AB,&szd_));
825:       pts = hHprev; hHprev = hH; hH = pts;
826:     }
827:     PetscCallBLAS("BLASgemm",BLASgemm_("N","N",&n_,&nv_,&n_,&sone,AB,&szd_,proj->V2,&szd_,&zero,w,&szd_));
828:     PetscCallBLAS("BLASgemm",BLASgemm_("C","N",&nv_,&nv_,&n_,&sone,proj->V2,&szd_,w,&szd_,&sone,T,&ldds_));
829:     DSRestoreArray(ds,mat,&T);
830:   }
831:   return 0;
832: }

834: PetscErrorCode NEPDeflationProjectOperator(NEP_EXT_OP extop,BV Vext,DS ds,PetscInt j0,PetscInt j1)
835: {
836:   PetscInt        k,j,n=extop->n,dim;
837:   Vec             v,ve;
838:   BV              V1;
839:   Mat             G;
840:   NEP             nep=extop->nep;
841:   NEP_DEF_PROJECT proj;

843:   NEPCheckSplit(extop->nep,1);
844:   proj = extop->proj;
845:   if (!proj) {
846:     /* Initialize the projection data structure */
847:     PetscNew(&proj);
848:     extop->proj = proj;
849:     proj->extop = extop;
850:     BVGetSizes(Vext,NULL,NULL,&dim);
851:     proj->dim = dim;
852:     if (extop->szd) {
853:       proj->lwork = 3*dim*dim+2*extop->szd*extop->szd+extop->szd;
854:       PetscMalloc3(dim*extop->szd,&proj->V2,nep->nt,&proj->V1pApX,proj->lwork,&proj->work);
855:       for (j=0;j<nep->nt;j++) MatCreateSeqDense(PETSC_COMM_SELF,proj->dim,extop->szd,NULL,&proj->V1pApX[j]);
856:       MatCreateSeqDense(PETSC_COMM_SELF,extop->szd,proj->dim,NULL,&proj->XpV1);
857:       BVCreateVec(extop->X,&proj->w);
858:       BVDuplicateResize(extop->X,proj->dim,&proj->V1);
859:     }
860:     DSNEPSetComputeMatrixFunction(ds,NEPDeflationDSNEPComputeMatrix,(void*)proj);
861:   }

863:   /* Split Vext in V1 and V2 */
864:   if (extop->szd) {
865:     for (j=j0;j<j1;j++) {
866:       BVGetColumn(Vext,j,&ve);
867:       BVGetColumn(proj->V1,j,&v);
868:       NEPDeflationCopyToExtendedVec(extop,v,proj->V2+j*extop->szd,ve,PETSC_TRUE);
869:       BVRestoreColumn(proj->V1,j,&v);
870:       BVRestoreColumn(Vext,j,&ve);
871:     }
872:     V1 = proj->V1;
873:   } else V1 = Vext;

875:   /* Compute matrices V1^* A_i V1 */
876:   BVSetActiveColumns(V1,j0,j1);
877:   for (k=0;k<nep->nt;k++) {
878:     DSGetMat(ds,DSMatExtra[k],&G);
879:     BVMatProject(V1,nep->A[k],V1,G);
880:     DSRestoreMat(ds,DSMatExtra[k],&G);
881:   }

883:   if (extop->n) {
884:     if (extop->szd) {
885:       /* Compute matrices V1^* A_i X  and V1^* X */
886:       BVSetActiveColumns(extop->W,0,n);
887:       for (k=0;k<nep->nt;k++) {
888:         BVMatMult(extop->X,nep->A[k],extop->W);
889:         BVDot(extop->W,V1,proj->V1pApX[k]);
890:       }
891:       BVDot(V1,extop->X,proj->XpV1);
892:     }
893:   }
894:   return 0;
895: }