Actual source code: pod.c

  1: #include <petsc/private/kspimpl.h>
  2: #include <petsc/private/matimpl.h>
  3: #include <petscblaslapack.h>
  4: static PetscBool  cited      = PETSC_FALSE;
  5: static const char citation[] = "@phdthesis{zampini2010non,\n"
  6:                                "  title={Non-overlapping Domain Decomposition Methods for Cardiac Reaction-Diffusion Models and Applications},\n"
  7:                                "  author={Zampini, S},\n"
  8:                                "  year={2010},\n"
  9:                                "  school={PhD thesis, Universita degli Studi di Milano}\n"
 10:                                "}\n";

 12: typedef struct {
 13:   PetscInt      maxn;  /* maximum number of snapshots */
 14:   PetscInt      n;     /* number of active snapshots */
 15:   PetscInt      curr;  /* current tip of snapshots set */
 16:   Vec          *xsnap; /* snapshots */
 17:   Vec          *bsnap; /* rhs snapshots */
 18:   Vec          *work;  /* parallel work vectors */
 19:   PetscScalar  *dots_iallreduce;
 20:   MPI_Request   req_iallreduce;
 21:   PetscInt      ndots_iallreduce; /* if we have iallreduce we can hide the VecMDot communications */
 22:   PetscReal     tol;              /* relative tolerance to retain eigenvalues */
 23:   PetscBool     Aspd;             /* if true, uses the SPD operator as inner product */
 24:   PetscScalar  *corr;             /* correlation matrix */
 25:   PetscReal    *eigs;             /* eigenvalues */
 26:   PetscScalar  *eigv;             /* eigenvectors */
 27:   PetscBLASInt  nen;              /* dimension of lower dimensional system */
 28:   PetscInt      st;               /* first eigenvector of correlation matrix to be retained */
 29:   PetscBLASInt *iwork;            /* integer work vector */
 30:   PetscScalar  *yhay;             /* Y^H * A * Y */
 31:   PetscScalar  *low;              /* lower dimensional linear system */
 32: #if defined(PETSC_USE_COMPLEX)
 33:   PetscReal *rwork;
 34: #endif
 35:   PetscBLASInt lwork;
 36:   PetscScalar *swork;
 37:   PetscBool    monitor;
 38: } KSPGuessPOD;

 40: static PetscErrorCode KSPGuessReset_POD(KSPGuess guess)
 41: {
 42:   KSPGuessPOD *pod  = (KSPGuessPOD *)guess->data;
 43:   PetscLayout  Alay = NULL, vlay = NULL;
 44:   PetscBool    cong;

 46:   PetscFunctionBegin;
 47:   pod->nen  = 0;
 48:   pod->n    = 0;
 49:   pod->curr = 0;
 50:   /* need to wait for completion of outstanding requests */
 51:   if (pod->ndots_iallreduce) PetscCallMPI(MPI_Wait(&pod->req_iallreduce, MPI_STATUS_IGNORE));
 52:   pod->ndots_iallreduce = 0;
 53:   /* destroy vectors if the size of the linear system has changed */
 54:   if (guess->A) PetscCall(MatGetLayouts(guess->A, &Alay, NULL));
 55:   if (pod->xsnap) PetscCall(VecGetLayout(pod->xsnap[0], &vlay));
 56:   cong = PETSC_FALSE;
 57:   if (vlay && Alay) PetscCall(PetscLayoutCompare(Alay, vlay, &cong));
 58:   if (!cong) {
 59:     PetscCall(VecDestroyVecs(pod->maxn, &pod->xsnap));
 60:     PetscCall(VecDestroyVecs(pod->maxn, &pod->bsnap));
 61:     PetscCall(VecDestroyVecs(1, &pod->work));
 62:   }
 63:   PetscFunctionReturn(PETSC_SUCCESS);
 64: }

 66: static PetscErrorCode KSPGuessSetUp_POD(KSPGuess guess)
 67: {
 68:   KSPGuessPOD *pod = (KSPGuessPOD *)guess->data;

 70:   PetscFunctionBegin;
 71:   if (!pod->corr) {
 72:     PetscScalar  sdummy;
 73:     PetscReal    rdummy = 0;
 74:     PetscBLASInt bN, idummy = 0;

 76:     PetscCall(PetscCalloc6(pod->maxn * pod->maxn, &pod->corr, pod->maxn, &pod->eigs, pod->maxn * pod->maxn, &pod->eigv, 6 * pod->maxn, &pod->iwork, pod->maxn * pod->maxn, &pod->yhay, pod->maxn * pod->maxn, &pod->low));
 77: #if defined(PETSC_USE_COMPLEX)
 78:     PetscCall(PetscMalloc1(7 * pod->maxn, &pod->rwork));
 79: #endif
 80: #if defined(PETSC_HAVE_MPI_NONBLOCKING_COLLECTIVES)
 81:     PetscCall(PetscMalloc1(3 * pod->maxn, &pod->dots_iallreduce));
 82: #endif
 83:     pod->lwork = -1;
 84:     PetscCall(PetscBLASIntCast(pod->maxn, &bN));
 85: #if !defined(PETSC_USE_COMPLEX)
 86:     PetscCallLAPACKInfo("LAPACKsyevx", LAPACKsyevx_("V", "A", "L", &bN, pod->corr, &bN, &rdummy, &rdummy, &idummy, &idummy, &rdummy, &idummy, pod->eigs, pod->eigv, &bN, &sdummy, &pod->lwork, pod->iwork, pod->iwork + 5 * bN, &info));
 87: #else
 88:     PetscCallLAPACKInfo("LAPACKsyevx", LAPACKsyevx_("V", "A", "L", &bN, pod->corr, &bN, &rdummy, &rdummy, &idummy, &idummy, &rdummy, &idummy, pod->eigs, pod->eigv, &bN, &sdummy, &pod->lwork, pod->rwork, pod->iwork, pod->iwork + 5 * bN, &info));
 89: #endif
 90:     PetscCall(PetscBLASIntCast((PetscInt)PetscRealPart(sdummy), &pod->lwork));
 91:     PetscCall(PetscMalloc1(pod->lwork + PetscMax(bN * bN, 6 * bN), &pod->swork));
 92:   }
 93:   /* work vectors are sequential, we explicitly use MPI_Allreduce */
 94:   if (!pod->xsnap) {
 95:     Vec *v, vseq;

 97:     PetscCall(KSPCreateVecs(guess->ksp, 1, &v, 0, NULL));
 98:     PetscCall(VecCreateLocalVector(v[0], &vseq));
 99:     PetscCall(VecDestroyVecs(1, &v));
100:     PetscCall(VecDuplicateVecs(vseq, pod->maxn, &pod->xsnap));
101:     PetscCall(VecDestroy(&vseq));
102:   }
103:   if (!pod->bsnap) {
104:     Vec *v, vseq;

106:     PetscCall(KSPCreateVecs(guess->ksp, 0, NULL, 1, &v));
107:     PetscCall(VecCreateLocalVector(v[0], &vseq));
108:     PetscCall(VecDestroyVecs(1, &v));
109:     PetscCall(VecDuplicateVecs(vseq, pod->maxn, &pod->bsnap));
110:     PetscCall(VecDestroy(&vseq));
111:   }
112:   if (!pod->work) PetscCall(KSPCreateVecs(guess->ksp, 1, &pod->work, 0, NULL));
113:   PetscFunctionReturn(PETSC_SUCCESS);
114: }

116: static PetscErrorCode KSPGuessDestroy_POD(KSPGuess guess)
117: {
118:   KSPGuessPOD *pod = (KSPGuessPOD *)guess->data;

120:   PetscFunctionBegin;
121:   PetscCall(PetscFree6(pod->corr, pod->eigs, pod->eigv, pod->iwork, pod->yhay, pod->low));
122: #if defined(PETSC_USE_COMPLEX)
123:   PetscCall(PetscFree(pod->rwork));
124: #endif
125:   /* need to wait for completion before destroying dots_iallreduce */
126:   if (pod->ndots_iallreduce) PetscCallMPI(MPI_Wait(&pod->req_iallreduce, MPI_STATUS_IGNORE));
127:   PetscCall(PetscFree(pod->dots_iallreduce));
128:   PetscCall(PetscFree(pod->swork));
129:   PetscCall(VecDestroyVecs(pod->maxn, &pod->bsnap));
130:   PetscCall(VecDestroyVecs(pod->maxn, &pod->xsnap));
131:   PetscCall(VecDestroyVecs(1, &pod->work));
132:   PetscCall(PetscFree(pod));
133:   PetscFunctionReturn(PETSC_SUCCESS);
134: }

136: static PetscErrorCode KSPGuessUpdate_POD(KSPGuess, Vec, Vec);

138: static PetscErrorCode KSPGuessFormGuess_POD(KSPGuess guess, Vec b, Vec x)
139: {
140:   KSPGuessPOD *pod = (KSPGuessPOD *)guess->data;
141:   PetscScalar  one = 1, zero = 0;
142:   PetscBLASInt bN, ione      = 1, bNen;
143:   PetscInt     i;

145:   PetscFunctionBegin;
146:   PetscCall(PetscCitationsRegister(citation, &cited));
147:   if (pod->ndots_iallreduce) { /* complete communication and project the linear system */
148:     PetscCall(KSPGuessUpdate_POD(guess, NULL, NULL));
149:   }
150:   if (!pod->nen) PetscFunctionReturn(PETSC_SUCCESS);
151:   /* b_low = S * V^T * X^T * b */
152:   PetscCall(VecGetLocalVectorRead(b, pod->bsnap[pod->curr]));
153:   PetscCall(VecMDot(pod->bsnap[pod->curr], pod->n, pod->xsnap, pod->swork));
154:   PetscCall(VecRestoreLocalVectorRead(b, pod->bsnap[pod->curr]));
155:   PetscCallMPI(MPIU_Allreduce(pod->swork, pod->swork + pod->n, pod->n, MPIU_SCALAR, MPIU_SUM, PetscObjectComm((PetscObject)guess)));
156:   PetscCall(PetscBLASIntCast(pod->n, &bN));
157:   PetscCall(PetscBLASIntCast(pod->nen, &bNen));
158:   PetscCallBLAS("BLASgemv", BLASgemv_("T", &bN, &bNen, &one, pod->eigv + pod->st * pod->n, &bN, pod->swork + pod->n, &ione, &zero, pod->swork, &ione));
159:   if (pod->monitor) {
160:     PetscCall(PetscPrintf(PetscObjectComm((PetscObject)guess), "  KSPGuessPOD alphas = "));
161:     for (i = 0; i < pod->nen; i++) {
162: #if defined(PETSC_USE_COMPLEX)
163:       PetscCall(PetscPrintf(PetscObjectComm((PetscObject)guess), "%g + %g i", (double)PetscRealPart(pod->swork[i]), (double)PetscImaginaryPart(pod->swork[i])));
164: #else
165:       PetscCall(PetscPrintf(PetscObjectComm((PetscObject)guess), "%g ", (double)pod->swork[i]));
166: #endif
167:     }
168:     PetscCall(PetscPrintf(PetscObjectComm((PetscObject)guess), "\n"));
169:   }
170:   /* A_low x_low = b_low */
171:   if (!pod->Aspd) { /* A is spd -> LOW = Identity */
172:     KSP       pksp = guess->ksp;
173:     PetscBool tsolve, symm, set;

175:     if (pod->monitor) {
176:       PetscMPIInt rank;
177:       Mat         L;

179:       PetscCallMPI(MPI_Comm_rank(PetscObjectComm((PetscObject)guess), &rank));
180:       if (rank == 0) {
181:         PetscCall(PetscPrintf(PetscObjectComm((PetscObject)guess), "  L = "));
182:         PetscCall(MatCreateSeqDense(PETSC_COMM_SELF, pod->nen, pod->nen, pod->low, &L));
183:         PetscCall(MatView(L, NULL));
184:         PetscCall(MatDestroy(&L));
185:       }
186:     }
187:     PetscCall(MatIsSymmetricKnown(guess->A, &set, &symm));
188:     tsolve = (set && symm) ? PETSC_FALSE : pksp->transpose_solve;
189:     PetscCallLAPACKInfo("LAPACKgetrf", LAPACKgetrf_(&bNen, &bNen, pod->low, &bNen, pod->iwork, &info));
190:     PetscCallLAPACKInfo("LAPACKgetrs", LAPACKgetrs_(tsolve ? "T" : "N", &bNen, &ione, pod->low, &bNen, pod->iwork, pod->swork, &bNen, &info));
191:   }
192:   /* x = X * V * S * x_low */
193:   PetscCallBLAS("BLASgemv", BLASgemv_("N", &bN, &bNen, &one, pod->eigv + pod->st * pod->n, &bN, pod->swork, &ione, &zero, pod->swork + pod->n, &ione));
194:   if (pod->monitor) {
195:     PetscCall(PetscPrintf(PetscObjectComm((PetscObject)guess), "  KSPGuessPOD sol = "));
196:     for (i = 0; i < pod->nen; i++) {
197: #if defined(PETSC_USE_COMPLEX)
198:       PetscCall(PetscPrintf(PetscObjectComm((PetscObject)guess), "%g + %g i", (double)PetscRealPart(pod->swork[i + pod->n]), (double)PetscImaginaryPart(pod->swork[i + pod->n])));
199: #else
200:       PetscCall(PetscPrintf(PetscObjectComm((PetscObject)guess), "%g ", (double)pod->swork[i + pod->n]));
201: #endif
202:     }
203:     PetscCall(PetscPrintf(PetscObjectComm((PetscObject)guess), "\n"));
204:   }
205:   PetscCall(VecGetLocalVector(x, pod->bsnap[pod->curr]));
206:   PetscCall(VecSet(pod->bsnap[pod->curr], 0));
207:   PetscCall(VecMAXPY(pod->bsnap[pod->curr], pod->n, pod->swork + pod->n, pod->xsnap));
208:   PetscCall(VecRestoreLocalVector(x, pod->bsnap[pod->curr]));
209:   PetscFunctionReturn(PETSC_SUCCESS);
210: }

212: static PetscErrorCode KSPGuessUpdate_POD(KSPGuess guess, Vec b, Vec x)
213: {
214:   KSPGuessPOD *pod = (KSPGuessPOD *)guess->data;
215:   PetscScalar  one = 1, zero = 0;
216:   PetscReal    toten, parten, reps = 0; /* dlamch? */
217:   PetscBLASInt bN, idummy = 0;
218:   PetscInt     i;
219:   PetscMPIInt  podn;

221:   PetscFunctionBegin;
222:   if (pod->ndots_iallreduce) goto complete_request;
223:   pod->n = pod->n < pod->maxn ? pod->n + 1 : pod->maxn;
224:   PetscCall(PetscMPIIntCast(pod->n, &podn));
225:   PetscCall(VecCopy(x, pod->xsnap[pod->curr]));
226:   PetscCall(KSP_MatMult(guess->ksp, guess->A, x, pod->work[0]));
227:   PetscCall(VecCopy(pod->work[0], pod->bsnap[pod->curr]));
228:   if (pod->Aspd) {
229:     PetscCall(VecMDot(pod->xsnap[pod->curr], pod->n, pod->bsnap, pod->swork));
230: #if !defined(PETSC_HAVE_MPI_NONBLOCKING_COLLECTIVES)
231:     PetscCallMPI(MPIU_Allreduce(pod->swork, pod->swork + 3 * pod->n, podn, MPIU_SCALAR, MPIU_SUM, PetscObjectComm((PetscObject)guess)));
232: #else
233:     PetscCallMPI(MPI_Iallreduce(pod->swork, pod->dots_iallreduce, podn, MPIU_SCALAR, MPIU_SUM, PetscObjectComm((PetscObject)guess), &pod->req_iallreduce));
234:     pod->ndots_iallreduce = 1;
235: #endif
236:   } else {
237:     PetscInt  off;
238:     PetscBool set, herm;

240: #if defined(PETSC_USE_COMPLEX)
241:     PetscCall(MatIsHermitianKnown(guess->A, &set, &herm));
242: #else
243:     PetscCall(MatIsSymmetricKnown(guess->A, &set, &herm));
244: #endif
245:     off = (guess->ksp->transpose_solve && (!set || !herm)) ? 2 * pod->n : pod->n;

247:     /* TODO: we may want to use a user-defined dot for the correlation matrix */
248:     PetscCall(VecMDot(pod->xsnap[pod->curr], pod->n, pod->xsnap, pod->swork));
249:     PetscCall(VecMDot(pod->bsnap[pod->curr], pod->n, pod->xsnap, pod->swork + off));
250:     if (!set || !herm) {
251:       off = (off == pod->n) ? 2 * pod->n : pod->n;
252:       PetscCall(VecMDot(pod->xsnap[pod->curr], pod->n, pod->bsnap, pod->swork + off));
253: #if !defined(PETSC_HAVE_MPI_NONBLOCKING_COLLECTIVES)
254:       PetscCallMPI(MPIU_Allreduce(pod->swork, pod->swork + 3 * pod->n, 3 * podn, MPIU_SCALAR, MPIU_SUM, PetscObjectComm((PetscObject)guess)));
255: #else
256:       PetscCallMPI(MPI_Iallreduce(pod->swork, pod->dots_iallreduce, 3 * podn, MPIU_SCALAR, MPIU_SUM, PetscObjectComm((PetscObject)guess), &pod->req_iallreduce));
257:       pod->ndots_iallreduce = 3;
258: #endif
259:     } else {
260: #if !defined(PETSC_HAVE_MPI_NONBLOCKING_COLLECTIVES)
261:       PetscCallMPI(MPIU_Allreduce(pod->swork, pod->swork + 3 * pod->n, 2 * podn, MPIU_SCALAR, MPIU_SUM, PetscObjectComm((PetscObject)guess)));
262:       for (i = 0; i < pod->n; i++) pod->swork[5 * pod->n + i] = pod->swork[4 * pod->n + i];
263: #else
264:       PetscCallMPI(MPI_Iallreduce(pod->swork, pod->dots_iallreduce, 2 * podn, MPIU_SCALAR, MPIU_SUM, PetscObjectComm((PetscObject)guess), &pod->req_iallreduce));
265:       pod->ndots_iallreduce = 2;
266: #endif
267:     }
268:   }
269:   if (pod->ndots_iallreduce) PetscFunctionReturn(PETSC_SUCCESS);

271: complete_request:
272:   if (pod->ndots_iallreduce) {
273:     PetscCallMPI(MPI_Wait(&pod->req_iallreduce, MPI_STATUS_IGNORE));
274:     switch (pod->ndots_iallreduce) {
275:     case 3:
276:       for (i = 0; i < pod->n; i++) pod->swork[3 * pod->n + i] = pod->dots_iallreduce[i];
277:       for (i = 0; i < pod->n; i++) pod->swork[4 * pod->n + i] = pod->dots_iallreduce[pod->n + i];
278:       for (i = 0; i < pod->n; i++) pod->swork[5 * pod->n + i] = pod->dots_iallreduce[2 * pod->n + i];
279:       break;
280:     case 2:
281:       for (i = 0; i < pod->n; i++) pod->swork[3 * pod->n + i] = pod->dots_iallreduce[i];
282:       for (i = 0; i < pod->n; i++) pod->swork[4 * pod->n + i] = pod->dots_iallreduce[pod->n + i];
283:       for (i = 0; i < pod->n; i++) pod->swork[5 * pod->n + i] = pod->dots_iallreduce[pod->n + i];
284:       break;
285:     case 1:
286:       for (i = 0; i < pod->n; i++) pod->swork[3 * pod->n + i] = pod->dots_iallreduce[i];
287:       break;
288:     default:
289:       SETERRQ(PetscObjectComm((PetscObject)guess), PETSC_ERR_PLIB, "Invalid number of outstanding dots operations: %" PetscInt_FMT, pod->ndots_iallreduce);
290:     }
291:   }
292:   pod->ndots_iallreduce = 0;

294:   /* correlation matrix and Y^H A Y (Galerkin) */
295:   for (i = 0; i < pod->n; i++) {
296:     pod->corr[pod->curr * pod->maxn + i] = pod->swork[3 * pod->n + i];
297:     pod->corr[i * pod->maxn + pod->curr] = PetscConj(pod->swork[3 * pod->n + i]);
298:     if (!pod->Aspd) {
299:       pod->yhay[pod->curr * pod->maxn + i] = pod->swork[4 * pod->n + i];
300:       pod->yhay[i * pod->maxn + pod->curr] = PetscConj(pod->swork[5 * pod->n + i]);
301:     }
302:   }
303:   /* syevx changes the input matrix */
304:   for (i = 0; i < pod->n; i++) {
305:     for (PetscInt j = i; j < pod->n; j++) pod->swork[i * pod->n + j] = pod->corr[i * pod->maxn + j];
306:   }
307:   PetscCall(PetscBLASIntCast(pod->n, &bN));
308: #if !defined(PETSC_USE_COMPLEX)
309:   PetscCallLAPACKInfo("LAPACKsyevx", LAPACKsyevx_("V", "A", "L", &bN, pod->swork, &bN, &reps, &reps, &idummy, &idummy, &reps, &idummy, pod->eigs, pod->eigv, &bN, pod->swork + bN * bN, &pod->lwork, pod->iwork, pod->iwork + 5 * bN, &info));
310: #else
311:   PetscCallLAPACKInfo("LAPACKsyevx", LAPACKsyevx_("V", "A", "L", &bN, pod->swork, &bN, &reps, &reps, &idummy, &idummy, &reps, &idummy, pod->eigs, pod->eigv, &bN, pod->swork + bN * bN, &pod->lwork, pod->rwork, pod->iwork, pod->iwork + 5 * bN, &info));
312: #endif

314:   /* dimension of lower dimensional system */
315:   pod->st = -1;
316:   for (i = 0, toten = 0; i < pod->n; i++) {
317:     pod->eigs[i] = PetscMax(pod->eigs[i], 0.0);
318:     toten += pod->eigs[i];
319:     if (!pod->eigs[i]) pod->st = i;
320:   }
321:   pod->nen = 0;
322:   for (i = pod->n - 1, parten = 0; i > pod->st && toten > 0; i--) {
323:     pod->nen++;
324:     parten += pod->eigs[i];
325:     if (parten + toten * pod->tol >= toten) break;
326:   }
327:   pod->st = pod->n - pod->nen;

329:   /* Compute eigv = V * S */
330:   for (i = pod->st; i < pod->n; i++) {
331:     const PetscReal v  = 1.0 / PetscSqrtReal(pod->eigs[i]);
332:     const PetscInt  st = pod->n * i;

334:     for (PetscInt j = 0; j < pod->n; j++) pod->eigv[st + j] *= v;
335:   }

337:   /* compute S * V^T * X^T * A * X * V * S if needed */
338:   if (pod->nen && !pod->Aspd) {
339:     PetscBLASInt bNen, bMaxN;
340:     PetscInt     st = pod->st * pod->n;
341:     PetscCall(PetscBLASIntCast(pod->nen, &bNen));
342:     PetscCall(PetscBLASIntCast(pod->maxn, &bMaxN));
343:     PetscCallBLAS("BLASgemm", BLASgemm_("T", "N", &bNen, &bN, &bN, &one, pod->eigv + st, &bN, pod->yhay, &bMaxN, &zero, pod->swork, &bNen));
344:     PetscCallBLAS("BLASgemm", BLASgemm_("N", "N", &bNen, &bNen, &bN, &one, pod->swork, &bNen, pod->eigv + st, &bN, &zero, pod->low, &bNen));
345:   }

347:   if (pod->monitor) {
348:     PetscMPIInt rank;
349:     Mat         C;

351:     PetscCallMPI(MPI_Comm_rank(PetscObjectComm((PetscObject)guess), &rank));
352:     if (rank == 0) {
353:       PetscCall(PetscPrintf(PetscObjectComm((PetscObject)guess), "  C = "));
354:       PetscCall(MatCreateSeqDense(PETSC_COMM_SELF, pod->n, pod->n, pod->corr, &C));
355:       PetscCall(MatDenseSetLDA(C, pod->maxn));
356:       PetscCall(MatView(C, NULL));
357:       PetscCall(MatDestroy(&C));
358:       PetscCall(PetscPrintf(PetscObjectComm((PetscObject)guess), "  YHAY = "));
359:       PetscCall(MatCreateSeqDense(PETSC_COMM_SELF, pod->n, pod->n, pod->yhay, &C));
360:       PetscCall(MatDenseSetLDA(C, pod->maxn));
361:       PetscCall(MatView(C, NULL));
362:       PetscCall(MatDestroy(&C));
363:     }
364:     PetscCall(PetscPrintf(PetscObjectComm((PetscObject)guess), "  KSPGuessPOD: basis %" PetscBLASInt_FMT ", energy fractions = ", pod->nen));
365:     for (i = pod->n - 1; i >= 0; i--) PetscCall(PetscPrintf(PetscObjectComm((PetscObject)guess), "%1.6e (%d) ", (double)(pod->eigs[i] / toten), i >= pod->st ? 1 : 0));
366:     PetscCall(PetscPrintf(PetscObjectComm((PetscObject)guess), "\n"));
367:     if (PetscDefined(USE_DEBUG)) {
368:       for (i = 0; i < pod->n; i++) {
369:         Vec          v;
370:         PetscBLASInt bNen, ione = 1;

372:         PetscCall(VecDuplicate(pod->xsnap[i], &v));
373:         PetscCall(VecCopy(pod->xsnap[i], v));
374:         PetscCall(PetscBLASIntCast(pod->nen, &bNen));
375:         PetscCallBLAS("BLASgemv", BLASgemv_("T", &bN, &bNen, &one, pod->eigv + pod->st * pod->n, &bN, pod->corr + pod->maxn * i, &ione, &zero, pod->swork, &ione));
376:         PetscCallBLAS("BLASgemv", BLASgemv_("N", &bN, &bNen, &one, pod->eigv + pod->st * pod->n, &bN, pod->swork, &ione, &zero, pod->swork + pod->n, &ione));
377:         for (PetscInt j = 0; j < pod->n; j++) pod->swork[j] = -pod->swork[pod->n + j];
378:         PetscCall(VecMAXPY(v, pod->n, pod->swork, pod->xsnap));
379:         PetscCall(VecDot(v, v, pod->swork));
380:         PetscCallMPI(MPIU_Allreduce(pod->swork, pod->swork + 1, 1, MPIU_SCALAR, MPIU_SUM, PetscObjectComm((PetscObject)guess)));
381:         PetscCall(PetscPrintf(PetscObjectComm((PetscObject)guess), "  Error projection %" PetscInt_FMT ": %g (expected lower than %g)\n", i, (double)PetscRealPart(pod->swork[1]), (double)(toten - parten)));
382:         PetscCall(VecDestroy(&v));
383:       }
384:     }
385:   }
386:   /* new tip */
387:   pod->curr = (pod->curr + 1) % pod->maxn;
388:   PetscFunctionReturn(PETSC_SUCCESS);
389: }

391: static PetscErrorCode KSPGuessSetFromOptions_POD(KSPGuess guess)
392: {
393:   KSPGuessPOD *pod = (KSPGuessPOD *)guess->data;

395:   PetscFunctionBegin;
396:   PetscOptionsBegin(PetscObjectComm((PetscObject)guess), ((PetscObject)guess)->prefix, "POD initial guess options", "KSPGuess");
397:   PetscCall(PetscOptionsInt("-ksp_guess_pod_size", "Number of snapshots", NULL, pod->maxn, &pod->maxn, NULL));
398:   PetscCall(PetscOptionsBool("-ksp_guess_pod_monitor", "Monitor initial guess generator", NULL, pod->monitor, &pod->monitor, NULL));
399:   PetscCall(PetscOptionsReal("-ksp_guess_pod_tol", "Tolerance to retain eigenvectors", "KSPGuessSetTolerance", pod->tol, &pod->tol, NULL));
400:   PetscCall(PetscOptionsBool("-ksp_guess_pod_Ainner", "Use the operator as inner product (must be SPD)", NULL, pod->Aspd, &pod->Aspd, NULL));
401:   PetscOptionsEnd();
402:   PetscFunctionReturn(PETSC_SUCCESS);
403: }

405: static PetscErrorCode KSPGuessSetTolerance_POD(KSPGuess guess, PetscReal tol)
406: {
407:   KSPGuessPOD *pod = (KSPGuessPOD *)guess->data;

409:   PetscFunctionBegin;
410:   pod->tol = tol;
411:   PetscFunctionReturn(PETSC_SUCCESS);
412: }

414: static PetscErrorCode KSPGuessView_POD(KSPGuess guess, PetscViewer viewer)
415: {
416:   KSPGuessPOD *pod = (KSPGuessPOD *)guess->data;
417:   PetscBool    isascii;

419:   PetscFunctionBegin;
420:   PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &isascii));
421:   if (isascii) PetscCall(PetscViewerASCIIPrintf(viewer, "Max size %" PetscInt_FMT ", tolerance %g, Ainner %d\n", pod->maxn, (double)pod->tol, pod->Aspd));
422:   PetscFunctionReturn(PETSC_SUCCESS);
423: }

425: /*MC
426:     KSPGUESSPOD - Implements a proper orthogonal decomposition based Galerkin scheme for repeated linear system solves.

428:   Options Database Keys:
429: +  -ksp_guess_pod_size size            - Number of snapshots
430: .  -ksp_guess_pod_monitor (true|false) - Monitor initial guess generator
431: .  -ksp_guess_pod_tol tol              - Tolerance to retain eigenvectors
432: -  -ksp_guess_pod_Ainner (true|false)  - Use the operator as inner product (must be SPD)

434:   Level: intermediate

436:   Note:
437:   The initial guess is obtained by solving a small and dense linear system, obtained by Galerkin projection on a lower dimensional space generated by the previous solutions as presented in {cite}`volkwein2013proper`.

439: .seealso: [](ch_ksp), `KSPGuess`, `KSPGuessType`, `KSPGuessCreate()`, `KSPSetGuess()`, `KSPGetGuess()`
440: M*/
441: PetscErrorCode KSPGuessCreate_POD(KSPGuess guess)
442: {
443:   KSPGuessPOD *pod;

445:   PetscFunctionBegin;
446:   PetscCall(PetscNew(&pod));
447:   pod->maxn   = 10;
448:   pod->tol    = PETSC_MACHINE_EPSILON;
449:   guess->data = pod;

451:   guess->ops->setfromoptions = KSPGuessSetFromOptions_POD;
452:   guess->ops->destroy        = KSPGuessDestroy_POD;
453:   guess->ops->settolerance   = KSPGuessSetTolerance_POD;
454:   guess->ops->setup          = KSPGuessSetUp_POD;
455:   guess->ops->view           = KSPGuessView_POD;
456:   guess->ops->reset          = KSPGuessReset_POD;
457:   guess->ops->update         = KSPGuessUpdate_POD;
458:   guess->ops->formguess      = KSPGuessFormGuess_POD;
459:   PetscFunctionReturn(PETSC_SUCCESS);
460: }