Actual source code: trlanczos.c

slepc-3.20.1 2023-11-27
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:    SLEPc singular value solver: "trlanczos"

 13:    Method: Thick-restart Lanczos

 15:    Algorithm:

 17:        Golub-Kahan-Lanczos bidiagonalization with thick-restart.

 19:    References:

 21:        [1] G.H. Golub and W. Kahan, "Calculating the singular values
 22:            and pseudo-inverse of a matrix", SIAM J. Numer. Anal. Ser.
 23:            B 2:205-224, 1965.

 25:        [2] V. Hernandez, J.E. Roman, and A. Tomas, "A robust and
 26:            efficient parallel SVD solver based on restarted Lanczos
 27:            bidiagonalization", Elec. Trans. Numer. Anal. 31:68-85,
 28:            2008.
 29: */

 31: #include <slepc/private/svdimpl.h>
 32: #include <slepc/private/bvimpl.h>

 34: static PetscBool  cited = PETSC_FALSE,citedg = PETSC_FALSE;
 35: static const char citation[] =
 36:   "@Article{slepc-svd,\n"
 37:   "   author = \"V. Hern{\\'a}ndez and J. E. Rom{\\'a}n and A. Tom{\\'a}s\",\n"
 38:   "   title = \"A robust and efficient parallel {SVD} solver based on restarted {Lanczos} bidiagonalization\",\n"
 39:   "   journal = \"Electron. Trans. Numer. Anal.\",\n"
 40:   "   volume = \"31\",\n"
 41:   "   pages = \"68--85\",\n"
 42:   "   year = \"2008\"\n"
 43:   "}\n";
 44: static const char citationg[] =
 45:   "@Article{slepc-gsvd,\n"
 46:   "   author = \"F. Alvarruiz and C. Campos and J. E. Roman\",\n"
 47:   "   title = \"Thick-restarted {Lanczos} bidiagonalization methods for the {GSVD}\",\n"
 48:   "   note = \"arXiv:2206.03768\",\n"
 49:   "   year = \"2022\"\n"
 50:   "}\n";

 52: typedef struct {
 53:   /* user parameters */
 54:   PetscBool           oneside;   /* one-sided variant */
 55:   PetscReal           keep;      /* restart parameter */
 56:   PetscBool           lock;      /* locking/non-locking variant */
 57:   KSP                 ksp;       /* solver for least-squares problem in GSVD */
 58:   SVDTRLanczosGBidiag bidiag;    /* bidiagonalization variant for GSVD */
 59:   PetscReal           scalef;    /* scale factor for matrix B */
 60:   PetscReal           scaleth;   /* scale threshold for automatic scaling */
 61:   PetscBool           explicitmatrix;
 62:   /* auxiliary variables */
 63:   Mat                 Z;         /* aux matrix for GSVD, Z=[A;B] */
 64: } SVD_TRLANCZOS;

 66: /* Context for shell matrix [A; B] */
 67: typedef struct {
 68:   Mat       A,B,AT,BT;
 69:   Vec       y1,y2,y;
 70:   PetscInt  m;
 71:   PetscReal scalef;
 72: } MatZData;

 74: static PetscErrorCode MatZCreateContext(SVD svd,MatZData **zdata)
 75: {
 76:   SVD_TRLANCZOS  *lanczos = (SVD_TRLANCZOS*)svd->data;

 78:   PetscFunctionBegin;
 79:   PetscCall(PetscNew(zdata));
 80:   (*zdata)->A = svd->A;
 81:   (*zdata)->B = svd->B;
 82:   (*zdata)->AT = svd->AT;
 83:   (*zdata)->BT = svd->BT;
 84:   (*zdata)->scalef = lanczos->scalef;
 85:   PetscCall(MatCreateVecsEmpty(svd->A,NULL,&(*zdata)->y1));
 86:   PetscCall(MatCreateVecsEmpty(svd->B,NULL,&(*zdata)->y2));
 87:   PetscCall(VecGetLocalSize((*zdata)->y1,&(*zdata)->m));
 88:   PetscCall(BVCreateVec(svd->U,&(*zdata)->y));
 89:   PetscFunctionReturn(PETSC_SUCCESS);
 90: }

 92: /* Update scale factor for B in Z=[A;B]
 93:    If matrices are swapped, the scale factor is inverted.*/
 94: static PetscErrorCode MatZUpdateScale(SVD svd)
 95: {
 96:   SVD_TRLANCZOS  *lanczos = (SVD_TRLANCZOS*)svd->data;
 97:   MatZData       *zdata;
 98:   Mat            mats[2],normal;
 99:   MatType        Atype;
100:   PetscBool      sametype;
101:   PetscReal      scalef = svd->swapped? 1.0/lanczos->scalef : lanczos->scalef;

103:   PetscFunctionBegin;
104:   if (lanczos->explicitmatrix) {
105:     /* Destroy the matrix Z and create it again */
106:     PetscCall(MatDestroy(&lanczos->Z));
107:     mats[0] = svd->A;
108:     if (scalef == 1.0) {
109:       mats[1] = svd->B;
110:     } else {
111:       PetscCall(MatDuplicate(svd->B,MAT_COPY_VALUES,&mats[1]));
112:       PetscCall(MatScale(mats[1],scalef));
113:     }
114:     PetscCall(MatCreateNest(PetscObjectComm((PetscObject)svd),2,NULL,1,NULL,mats,&lanczos->Z));
115:     PetscCall(MatGetType(svd->A,&Atype));
116:     PetscCall(PetscObjectTypeCompare((PetscObject)svd->B,Atype,&sametype));
117:     if (!sametype) Atype = MATAIJ;
118:     PetscCall(MatConvert(lanczos->Z,Atype,MAT_INPLACE_MATRIX,&lanczos->Z));
119:     if (scalef != 1.0) PetscCall(MatDestroy(&mats[1]));
120:   } else {
121:     PetscCall(MatShellGetContext(lanczos->Z,&zdata));
122:     zdata->scalef = scalef;
123:   }

125:   /* create normal equations matrix, to build the preconditioner in LSQR */
126:   PetscCall(MatCreateNormalHermitian(lanczos->Z,&normal));

128:   if (!lanczos->ksp) PetscCall(SVDTRLanczosGetKSP(svd,&lanczos->ksp));
129:   PetscCall(SVD_KSPSetOperators(lanczos->ksp,lanczos->Z,normal));
130:   PetscCall(KSPSetUp(lanczos->ksp));
131:   PetscCall(MatDestroy(&normal));
132:   PetscFunctionReturn(PETSC_SUCCESS);
133: }

135: static PetscErrorCode MatDestroy_Z(Mat Z)
136: {
137:   MatZData       *zdata;

139:   PetscFunctionBegin;
140:   PetscCall(MatShellGetContext(Z,&zdata));
141:   PetscCall(VecDestroy(&zdata->y1));
142:   PetscCall(VecDestroy(&zdata->y2));
143:   PetscCall(VecDestroy(&zdata->y));
144:   PetscCall(PetscFree(zdata));
145:   PetscFunctionReturn(PETSC_SUCCESS);
146: }

148: static PetscErrorCode MatMult_Z(Mat Z,Vec x,Vec y)
149: {
150:   MatZData       *zdata;
151:   PetscScalar    *y_elems;

153:   PetscFunctionBegin;
154:   PetscCall(MatShellGetContext(Z,&zdata));
155:   PetscCall(VecGetArray(y,&y_elems));
156:   PetscCall(VecPlaceArray(zdata->y1,y_elems));
157:   PetscCall(VecPlaceArray(zdata->y2,y_elems+zdata->m));

159:   PetscCall(MatMult(zdata->A,x,zdata->y1));
160:   PetscCall(MatMult(zdata->B,x,zdata->y2));
161:   PetscCall(VecScale(zdata->y2,zdata->scalef));

163:   PetscCall(VecResetArray(zdata->y1));
164:   PetscCall(VecResetArray(zdata->y2));
165:   PetscCall(VecRestoreArray(y,&y_elems));
166:   PetscFunctionReturn(PETSC_SUCCESS);
167: }

169: static PetscErrorCode MatMultTranspose_Z(Mat Z,Vec y,Vec x)
170: {
171:   MatZData          *zdata;
172:   const PetscScalar *y_elems;

174:   PetscFunctionBegin;
175:   PetscCall(MatShellGetContext(Z,&zdata));
176:   PetscCall(VecGetArrayRead(y,&y_elems));
177:   PetscCall(VecPlaceArray(zdata->y1,y_elems));
178:   PetscCall(VecPlaceArray(zdata->y2,y_elems+zdata->m));

180:   PetscCall(MatMult(zdata->BT,zdata->y2,x));
181:   PetscCall(VecScale(x,zdata->scalef));
182:   PetscCall(MatMultAdd(zdata->AT,zdata->y1,x,x));

184:   PetscCall(VecResetArray(zdata->y1));
185:   PetscCall(VecResetArray(zdata->y2));
186:   PetscCall(VecRestoreArrayRead(y,&y_elems));
187:   PetscFunctionReturn(PETSC_SUCCESS);
188: }

190: static PetscErrorCode MatCreateVecs_Z(Mat Z,Vec *right,Vec *left)
191: {
192:   MatZData       *zdata;

194:   PetscFunctionBegin;
195:   PetscCall(MatShellGetContext(Z,&zdata));
196:   if (right) PetscCall(MatCreateVecs(zdata->A,right,NULL));
197:   if (left) PetscCall(VecDuplicate(zdata->y,left));
198:   PetscFunctionReturn(PETSC_SUCCESS);
199: }

201: #define SWAP(a,b,t) do {t=a;a=b;b=t;} while (0)

203: static PetscErrorCode SVDSetUp_TRLanczos(SVD svd)
204: {
205:   PetscInt       M,N,P,m,n,p;
206:   SVD_TRLANCZOS  *lanczos = (SVD_TRLANCZOS*)svd->data;
207:   MatZData       *zdata;
208:   Mat            aux;

210:   PetscFunctionBegin;
211:   PetscCall(MatGetSize(svd->A,&M,&N));
212:   PetscCall(SVDSetDimensions_Default(svd));
213:   PetscCheck(svd->ncv<=svd->nsv+svd->mpd,PetscObjectComm((PetscObject)svd),PETSC_ERR_USER_INPUT,"The value of ncv must not be larger than nsv+mpd");
214:   PetscCheck(lanczos->lock || svd->mpd>=svd->ncv,PetscObjectComm((PetscObject)svd),PETSC_ERR_SUP,"Should not use mpd parameter in non-locking variant");
215:   if (svd->max_it==PETSC_DEFAULT) svd->max_it = PetscMax(N/svd->ncv,100);
216:   if (!lanczos->keep) lanczos->keep = 0.5;
217:   svd->leftbasis = PETSC_TRUE;
218:   PetscCall(SVDAllocateSolution(svd,1));
219:   if (svd->isgeneralized) {
220:     PetscCall(MatGetSize(svd->B,&P,NULL));
221:     if (lanczos->bidiag == SVD_TRLANCZOS_GBIDIAG_LOWER && ((svd->which==SVD_LARGEST && P<=N) || (svd->which==SVD_SMALLEST && M>N && P<=N))) {
222:       SWAP(svd->A,svd->B,aux);
223:       SWAP(svd->AT,svd->BT,aux);
224:       svd->swapped = PETSC_TRUE;
225:     } else svd->swapped = PETSC_FALSE;

227:     PetscCall(SVDSetWorkVecs(svd,1,1));

229:     if (svd->conv==SVD_CONV_ABS) {  /* Residual norms are multiplied by matrix norms */
230:       if (!svd->nrma) PetscCall(MatNorm(svd->A,NORM_INFINITY,&svd->nrma));
231:       if (!svd->nrmb) PetscCall(MatNorm(svd->B,NORM_INFINITY,&svd->nrmb));
232:     }

234:     /* Create the matrix Z=[A;B] */
235:     PetscCall(MatGetLocalSize(svd->A,&m,&n));
236:     PetscCall(MatGetLocalSize(svd->B,&p,NULL));
237:     if (!lanczos->explicitmatrix) {
238:       PetscCall(MatDestroy(&lanczos->Z));
239:       PetscCall(MatZCreateContext(svd,&zdata));
240:       PetscCall(MatCreateShell(PetscObjectComm((PetscObject)svd),m+p,n,PETSC_DECIDE,PETSC_DECIDE,zdata,&lanczos->Z));
241:       PetscCall(MatShellSetOperation(lanczos->Z,MATOP_MULT,(void(*)(void))MatMult_Z));
242: #if defined(PETSC_USE_COMPLEX)
243:       PetscCall(MatShellSetOperation(lanczos->Z,MATOP_MULT_HERMITIAN_TRANSPOSE,(void(*)(void))MatMultTranspose_Z));
244: #else
245:       PetscCall(MatShellSetOperation(lanczos->Z,MATOP_MULT_TRANSPOSE,(void(*)(void))MatMultTranspose_Z));
246: #endif
247:       PetscCall(MatShellSetOperation(lanczos->Z,MATOP_CREATE_VECS,(void(*)(void))MatCreateVecs_Z));
248:       PetscCall(MatShellSetOperation(lanczos->Z,MATOP_DESTROY,(void(*)(void))MatDestroy_Z));
249:     }
250:     /* Explicit matrix is created here, when updating the scale */
251:     PetscCall(MatZUpdateScale(svd));

253:   } else if (svd->ishyperbolic) {
254:     PetscCall(BV_SetMatrixDiagonal(svd->swapped?svd->V:svd->U,svd->omega,svd->OP));
255:     PetscCall(SVDSetWorkVecs(svd,1,0));
256:   }
257:   PetscCall(DSSetCompact(svd->ds,PETSC_TRUE));
258:   PetscCall(DSSetExtraRow(svd->ds,PETSC_TRUE));
259:   PetscCall(DSAllocate(svd->ds,svd->ncv+1));
260:   PetscFunctionReturn(PETSC_SUCCESS);
261: }

263: static PetscErrorCode SVDOneSideTRLanczosMGS(SVD svd,PetscReal *alpha,PetscReal *beta,BV V,BV U,PetscInt nconv,PetscInt l,PetscInt n,PetscScalar* work)
264: {
265:   PetscReal      a,b;
266:   PetscInt       i,k=nconv+l;
267:   Vec            ui,ui1,vi;

269:   PetscFunctionBegin;
270:   PetscCall(BVGetColumn(V,k,&vi));
271:   PetscCall(BVGetColumn(U,k,&ui));
272:   PetscCall(MatMult(svd->A,vi,ui));
273:   PetscCall(BVRestoreColumn(V,k,&vi));
274:   PetscCall(BVRestoreColumn(U,k,&ui));
275:   if (l>0) {
276:     PetscCall(BVSetActiveColumns(U,nconv,n));
277:     for (i=0;i<l;i++) work[i]=beta[i+nconv];
278:     PetscCall(BVMultColumn(U,-1.0,1.0,k,work));
279:   }
280:   PetscCall(BVNormColumn(U,k,NORM_2,&a));
281:   PetscCall(BVScaleColumn(U,k,1.0/a));
282:   alpha[k] = a;

284:   for (i=k+1;i<n;i++) {
285:     PetscCall(BVGetColumn(V,i,&vi));
286:     PetscCall(BVGetColumn(U,i-1,&ui1));
287:     PetscCall(MatMult(svd->AT,ui1,vi));
288:     PetscCall(BVRestoreColumn(V,i,&vi));
289:     PetscCall(BVRestoreColumn(U,i-1,&ui1));
290:     PetscCall(BVOrthonormalizeColumn(V,i,PETSC_FALSE,&b,NULL));
291:     beta[i-1] = b;

293:     PetscCall(BVGetColumn(V,i,&vi));
294:     PetscCall(BVGetColumn(U,i,&ui));
295:     PetscCall(MatMult(svd->A,vi,ui));
296:     PetscCall(BVRestoreColumn(V,i,&vi));
297:     PetscCall(BVGetColumn(U,i-1,&ui1));
298:     PetscCall(VecAXPY(ui,-b,ui1));
299:     PetscCall(BVRestoreColumn(U,i-1,&ui1));
300:     PetscCall(BVRestoreColumn(U,i,&ui));
301:     PetscCall(BVNormColumn(U,i,NORM_2,&a));
302:     PetscCall(BVScaleColumn(U,i,1.0/a));
303:     alpha[i] = a;
304:   }

306:   PetscCall(BVGetColumn(V,n,&vi));
307:   PetscCall(BVGetColumn(U,n-1,&ui1));
308:   PetscCall(MatMult(svd->AT,ui1,vi));
309:   PetscCall(BVRestoreColumn(V,n,&vi));
310:   PetscCall(BVRestoreColumn(U,n-1,&ui1));
311:   PetscCall(BVOrthogonalizeColumn(V,n,NULL,&b,NULL));
312:   beta[n-1] = b;
313:   PetscFunctionReturn(PETSC_SUCCESS);
314: }

316: /*
317:   Custom CGS orthogonalization, preprocess after first orthogonalization
318: */
319: static PetscErrorCode SVDOrthogonalizeCGS(BV V,PetscInt i,PetscScalar* h,PetscReal a,BVOrthogRefineType refine,PetscReal eta,PetscReal *norm)
320: {
321:   PetscReal      sum,onorm;
322:   PetscScalar    dot;
323:   PetscInt       j;

325:   PetscFunctionBegin;
326:   switch (refine) {
327:   case BV_ORTHOG_REFINE_NEVER:
328:     PetscCall(BVNormColumn(V,i,NORM_2,norm));
329:     break;
330:   case BV_ORTHOG_REFINE_ALWAYS:
331:     PetscCall(BVSetActiveColumns(V,0,i));
332:     PetscCall(BVDotColumn(V,i,h));
333:     PetscCall(BVMultColumn(V,-1.0,1.0,i,h));
334:     PetscCall(BVNormColumn(V,i,NORM_2,norm));
335:     break;
336:   case BV_ORTHOG_REFINE_IFNEEDED:
337:     dot = h[i];
338:     onorm = PetscSqrtReal(PetscRealPart(dot)) / a;
339:     sum = 0.0;
340:     for (j=0;j<i;j++) {
341:       sum += PetscRealPart(h[j] * PetscConj(h[j]));
342:     }
343:     *norm = PetscRealPart(dot)/(a*a) - sum;
344:     if (*norm>0.0) *norm = PetscSqrtReal(*norm);
345:     else PetscCall(BVNormColumn(V,i,NORM_2,norm));
346:     if (*norm < eta*onorm) {
347:       PetscCall(BVSetActiveColumns(V,0,i));
348:       PetscCall(BVDotColumn(V,i,h));
349:       PetscCall(BVMultColumn(V,-1.0,1.0,i,h));
350:       PetscCall(BVNormColumn(V,i,NORM_2,norm));
351:     }
352:     break;
353:   }
354:   PetscFunctionReturn(PETSC_SUCCESS);
355: }

357: static PetscErrorCode SVDOneSideTRLanczosCGS(SVD svd,PetscReal *alpha,PetscReal *beta,BV V,BV U,PetscInt nconv,PetscInt l,PetscInt n,PetscScalar* work)
358: {
359:   PetscReal          a,b,eta;
360:   PetscInt           i,j,k=nconv+l;
361:   Vec                ui,ui1,vi;
362:   BVOrthogRefineType refine;

364:   PetscFunctionBegin;
365:   PetscCall(BVGetColumn(V,k,&vi));
366:   PetscCall(BVGetColumn(U,k,&ui));
367:   PetscCall(MatMult(svd->A,vi,ui));
368:   PetscCall(BVRestoreColumn(V,k,&vi));
369:   PetscCall(BVRestoreColumn(U,k,&ui));
370:   if (l>0) {
371:     PetscCall(BVSetActiveColumns(U,nconv,n));
372:     for (i=0;i<l;i++) work[i]=beta[i+nconv];
373:     PetscCall(BVMultColumn(U,-1.0,1.0,k,work));
374:   }
375:   PetscCall(BVGetOrthogonalization(V,NULL,&refine,&eta,NULL));

377:   for (i=k+1;i<n;i++) {
378:     PetscCall(BVGetColumn(V,i,&vi));
379:     PetscCall(BVGetColumn(U,i-1,&ui1));
380:     PetscCall(MatMult(svd->AT,ui1,vi));
381:     PetscCall(BVRestoreColumn(V,i,&vi));
382:     PetscCall(BVRestoreColumn(U,i-1,&ui1));
383:     PetscCall(BVNormColumnBegin(U,i-1,NORM_2,&a));
384:     if (refine == BV_ORTHOG_REFINE_IFNEEDED) {
385:       PetscCall(BVSetActiveColumns(V,0,i+1));
386:       PetscCall(BVGetColumn(V,i,&vi));
387:       PetscCall(BVDotVecBegin(V,vi,work));
388:     } else {
389:       PetscCall(BVSetActiveColumns(V,0,i));
390:       PetscCall(BVDotColumnBegin(V,i,work));
391:     }
392:     PetscCall(BVNormColumnEnd(U,i-1,NORM_2,&a));
393:     if (refine == BV_ORTHOG_REFINE_IFNEEDED) {
394:       PetscCall(BVDotVecEnd(V,vi,work));
395:       PetscCall(BVRestoreColumn(V,i,&vi));
396:       PetscCall(BVSetActiveColumns(V,0,i));
397:     } else PetscCall(BVDotColumnEnd(V,i,work));

399:     PetscCall(BVScaleColumn(U,i-1,1.0/a));
400:     for (j=0;j<i;j++) work[j] = work[j] / a;
401:     PetscCall(BVMultColumn(V,-1.0,1.0/a,i,work));
402:     PetscCall(SVDOrthogonalizeCGS(V,i,work,a,refine,eta,&b));
403:     PetscCall(BVScaleColumn(V,i,1.0/b));
404:     PetscCheck(PetscAbsReal(b)>10*PETSC_MACHINE_EPSILON,PetscObjectComm((PetscObject)svd),PETSC_ERR_PLIB,"Recurrence generated a zero vector; use a two-sided variant");

406:     PetscCall(BVGetColumn(V,i,&vi));
407:     PetscCall(BVGetColumn(U,i,&ui));
408:     PetscCall(BVGetColumn(U,i-1,&ui1));
409:     PetscCall(MatMult(svd->A,vi,ui));
410:     PetscCall(VecAXPY(ui,-b,ui1));
411:     PetscCall(BVRestoreColumn(V,i,&vi));
412:     PetscCall(BVRestoreColumn(U,i,&ui));
413:     PetscCall(BVRestoreColumn(U,i-1,&ui1));

415:     alpha[i-1] = a;
416:     beta[i-1] = b;
417:   }

419:   PetscCall(BVGetColumn(V,n,&vi));
420:   PetscCall(BVGetColumn(U,n-1,&ui1));
421:   PetscCall(MatMult(svd->AT,ui1,vi));
422:   PetscCall(BVRestoreColumn(V,n,&vi));
423:   PetscCall(BVRestoreColumn(U,n-1,&ui1));

425:   PetscCall(BVNormColumnBegin(svd->U,n-1,NORM_2,&a));
426:   if (refine == BV_ORTHOG_REFINE_IFNEEDED) {
427:     PetscCall(BVSetActiveColumns(V,0,n+1));
428:     PetscCall(BVGetColumn(V,n,&vi));
429:     PetscCall(BVDotVecBegin(V,vi,work));
430:   } else {
431:     PetscCall(BVSetActiveColumns(V,0,n));
432:     PetscCall(BVDotColumnBegin(V,n,work));
433:   }
434:   PetscCall(BVNormColumnEnd(svd->U,n-1,NORM_2,&a));
435:   if (refine == BV_ORTHOG_REFINE_IFNEEDED) {
436:     PetscCall(BVDotVecEnd(V,vi,work));
437:     PetscCall(BVRestoreColumn(V,n,&vi));
438:   } else PetscCall(BVDotColumnEnd(V,n,work));

440:   PetscCall(BVScaleColumn(U,n-1,1.0/a));
441:   for (j=0;j<n;j++) work[j] = work[j] / a;
442:   PetscCall(BVMultColumn(V,-1.0,1.0/a,n,work));
443:   PetscCall(SVDOrthogonalizeCGS(V,n,work,a,refine,eta,&b));
444:   PetscCall(BVSetActiveColumns(V,nconv,n));
445:   alpha[n-1] = a;
446:   beta[n-1] = b;
447:   PetscFunctionReturn(PETSC_SUCCESS);
448: }

450: static PetscErrorCode SVDSolve_TRLanczos(SVD svd)
451: {
452:   SVD_TRLANCZOS  *lanczos = (SVD_TRLANCZOS*)svd->data;
453:   PetscReal      *alpha,*beta;
454:   PetscScalar    *swork=NULL,*w;
455:   PetscInt       i,k,l,nv,ld;
456:   Mat            U,V;
457:   PetscBool      breakdown=PETSC_FALSE;
458:   BVOrthogType   orthog;

460:   PetscFunctionBegin;
461:   PetscCall(PetscCitationsRegister(citation,&cited));
462:   /* allocate working space */
463:   PetscCall(DSGetLeadingDimension(svd->ds,&ld));
464:   PetscCall(BVGetOrthogonalization(svd->V,&orthog,NULL,NULL,NULL));
465:   PetscCall(PetscMalloc1(ld,&w));
466:   if (lanczos->oneside) PetscCall(PetscMalloc1(svd->ncv+1,&swork));

468:   /* normalize start vector */
469:   if (!svd->nini) {
470:     PetscCall(BVSetRandomColumn(svd->V,0));
471:     PetscCall(BVOrthonormalizeColumn(svd->V,0,PETSC_TRUE,NULL,NULL));
472:   }

474:   l = 0;
475:   while (svd->reason == SVD_CONVERGED_ITERATING) {
476:     svd->its++;

478:     /* inner loop */
479:     nv = PetscMin(svd->nconv+svd->mpd,svd->ncv);
480:     PetscCall(DSGetArrayReal(svd->ds,DS_MAT_T,&alpha));
481:     beta = alpha + ld;
482:     if (lanczos->oneside) {
483:       if (orthog == BV_ORTHOG_MGS) PetscCall(SVDOneSideTRLanczosMGS(svd,alpha,beta,svd->V,svd->U,svd->nconv,l,nv,swork));
484:       else PetscCall(SVDOneSideTRLanczosCGS(svd,alpha,beta,svd->V,svd->U,svd->nconv,l,nv,swork));
485:     } else PetscCall(SVDTwoSideLanczos(svd,alpha,beta,svd->V,svd->U,svd->nconv+l,&nv,&breakdown));
486:     PetscCall(DSRestoreArrayReal(svd->ds,DS_MAT_T,&alpha));
487:     PetscCall(BVScaleColumn(svd->V,nv,1.0/beta[nv-1]));
488:     PetscCall(BVSetActiveColumns(svd->V,svd->nconv,nv));
489:     PetscCall(BVSetActiveColumns(svd->U,svd->nconv,nv));

491:     /* solve projected problem */
492:     PetscCall(DSSetDimensions(svd->ds,nv,svd->nconv,svd->nconv+l));
493:     PetscCall(DSSVDSetDimensions(svd->ds,nv));
494:     PetscCall(DSSetState(svd->ds,l?DS_STATE_RAW:DS_STATE_INTERMEDIATE));
495:     PetscCall(DSSolve(svd->ds,w,NULL));
496:     PetscCall(DSSort(svd->ds,w,NULL,NULL,NULL,NULL));
497:     PetscCall(DSUpdateExtraRow(svd->ds));
498:     PetscCall(DSSynchronize(svd->ds,w,NULL));
499:     for (i=svd->nconv;i<nv;i++) svd->sigma[i] = PetscRealPart(w[i]);

501:     /* check convergence */
502:     PetscCall(SVDKrylovConvergence(svd,PETSC_FALSE,svd->nconv,nv-svd->nconv,1.0,&k));
503:     PetscCall((*svd->stopping)(svd,svd->its,svd->max_it,k,svd->nsv,&svd->reason,svd->stoppingctx));

505:     /* update l */
506:     if (svd->reason != SVD_CONVERGED_ITERATING || breakdown || k==nv) l = 0;
507:     else l = PetscMax(1,(PetscInt)((nv-k)*lanczos->keep));
508:     if (!lanczos->lock && l>0) { l += k; k = 0; } /* non-locking variant: reset no. of converged triplets */
509:     if (l) PetscCall(PetscInfo(svd,"Preparing to restart keeping l=%" PetscInt_FMT " vectors\n",l));

511:     if (svd->reason == SVD_CONVERGED_ITERATING) {
512:       if (PetscUnlikely(breakdown || k==nv)) {
513:         /* Start a new bidiagonalization */
514:         PetscCall(PetscInfo(svd,"Breakdown in bidiagonalization (it=%" PetscInt_FMT ")\n",svd->its));
515:         if (k<svd->nsv) {
516:           PetscCall(BVSetRandomColumn(svd->V,k));
517:           PetscCall(BVOrthonormalizeColumn(svd->V,k,PETSC_FALSE,NULL,&breakdown));
518:           if (breakdown) {
519:             svd->reason = SVD_DIVERGED_BREAKDOWN;
520:             PetscCall(PetscInfo(svd,"Unable to generate more start vectors\n"));
521:           }
522:         }
523:       } else PetscCall(DSTruncate(svd->ds,k+l,PETSC_FALSE));
524:     }

526:     /* compute converged singular vectors and restart vectors */
527:     PetscCall(DSGetMat(svd->ds,DS_MAT_V,&V));
528:     PetscCall(BVMultInPlace(svd->V,V,svd->nconv,k+l));
529:     PetscCall(DSRestoreMat(svd->ds,DS_MAT_V,&V));
530:     PetscCall(DSGetMat(svd->ds,DS_MAT_U,&U));
531:     PetscCall(BVMultInPlace(svd->U,U,svd->nconv,k+l));
532:     PetscCall(DSRestoreMat(svd->ds,DS_MAT_U,&U));

534:     /* copy the last vector to be the next initial vector */
535:     if (svd->reason == SVD_CONVERGED_ITERATING && !breakdown) PetscCall(BVCopyColumn(svd->V,nv,k+l));

537:     svd->nconv = k;
538:     PetscCall(SVDMonitor(svd,svd->its,svd->nconv,svd->sigma,svd->errest,nv));
539:   }

541:   /* orthonormalize U columns in one side method */
542:   if (lanczos->oneside) {
543:     for (i=0;i<svd->nconv;i++) PetscCall(BVOrthonormalizeColumn(svd->U,i,PETSC_FALSE,NULL,NULL));
544:   }

546:   /* free working space */
547:   PetscCall(PetscFree(w));
548:   if (swork) PetscCall(PetscFree(swork));
549:   PetscCall(DSTruncate(svd->ds,svd->nconv,PETSC_TRUE));
550:   PetscFunctionReturn(PETSC_SUCCESS);
551: }

553: static PetscErrorCode SVDLanczosHSVD(SVD svd,PetscReal *alpha,PetscReal *beta,PetscReal *omega,Mat A,Mat AT,BV V,BV U,PetscInt k,PetscInt *n,PetscBool *breakdown)
554: {
555:   PetscInt       i;
556:   Vec            u,v,ou=svd->workl[0];
557:   PetscBool      lindep=PETSC_FALSE;
558:   PetscReal      norm;

560:   PetscFunctionBegin;
561:   for (i=k;i<*n;i++) {
562:     PetscCall(BVGetColumn(V,i,&v));
563:     PetscCall(BVGetColumn(U,i,&u));
564:     PetscCall(MatMult(A,v,u));
565:     PetscCall(BVRestoreColumn(V,i,&v));
566:     PetscCall(BVRestoreColumn(U,i,&u));
567:     PetscCall(BVOrthonormalizeColumn(U,i,PETSC_FALSE,alpha+i,&lindep));
568:     omega[i] = PetscSign(alpha[i]);
569:     if (PetscUnlikely(lindep)) {
570:       *n = i;
571:       break;
572:     }

574:     PetscCall(BVGetColumn(V,i+1,&v));
575:     PetscCall(BVGetColumn(U,i,&u));
576:     PetscCall(VecPointwiseMult(ou,svd->omega,u));
577:     PetscCall(MatMult(AT,ou,v));
578:     PetscCall(BVRestoreColumn(V,i+1,&v));
579:     PetscCall(BVRestoreColumn(U,i,&u));
580:     PetscCall(BVOrthonormalizeColumn(V,i+1,PETSC_FALSE,&norm,&lindep));
581:     beta[i] = omega[i]*norm;
582:     if (PetscUnlikely(lindep)) {
583:       *n = i+1;
584:       break;
585:     }
586:   }

588:   if (breakdown) *breakdown = lindep;
589:   PetscFunctionReturn(PETSC_SUCCESS);
590: }

592: static PetscErrorCode SVDSolve_TRLanczos_HSVD(SVD svd)
593: {
594:   SVD_TRLANCZOS  *lanczos = (SVD_TRLANCZOS*)svd->data;
595:   PetscReal      *alpha,*beta,*omega;
596:   PetscScalar    *w;
597:   PetscInt       i,k,l,nv,ld,nini;
598:   Mat            UU,VV,D,A,AT;
599:   BV             U,V;
600:   PetscBool      breakdown=PETSC_FALSE;
601:   BVOrthogType   orthog;
602:   Vec            vomega;

604:   PetscFunctionBegin;
605:   /* undo the effect of swapping in this function */
606:   if (svd->swapped) {
607:     A = svd->AT;
608:     AT = svd->A;
609:     U = svd->V;
610:     V = svd->U;
611:     nini = svd->ninil;
612:   } else {
613:     A = svd->A;
614:     AT = svd->AT;
615:     U = svd->U;
616:     V = svd->V;
617:     nini = svd->nini;
618:   }
619:   /* allocate working space */
620:   PetscCall(DSGetLeadingDimension(svd->ds,&ld));
621:   PetscCall(BVGetOrthogonalization(V,&orthog,NULL,NULL,NULL));
622:   PetscCall(PetscMalloc1(ld,&w));
623:   PetscCheck(!lanczos->oneside,PetscObjectComm((PetscObject)svd),PETSC_ERR_SUP,"Oneside orthogonalization not supported for HSVD");

625:   /* normalize start vector */
626:   if (!nini) {
627:     PetscCall(BVSetRandomColumn(V,0));
628:     PetscCall(BVOrthonormalizeColumn(V,0,PETSC_TRUE,NULL,NULL));
629:   }

631:   l = 0;
632:   while (svd->reason == SVD_CONVERGED_ITERATING) {
633:     svd->its++;

635:     /* inner loop */
636:     nv = PetscMin(svd->nconv+svd->mpd,svd->ncv);
637:     PetscCall(DSGetArrayReal(svd->ds,DS_MAT_T,&alpha));
638:     beta = alpha + ld;
639:     PetscCall(DSGetArrayReal(svd->ds,DS_MAT_D,&omega));
640:     PetscCall(SVDLanczosHSVD(svd,alpha,beta,omega,A,AT,V,U,svd->nconv+l,&nv,&breakdown));
641:     PetscCall(DSRestoreArrayReal(svd->ds,DS_MAT_T,&alpha));
642:     PetscCall(DSRestoreArrayReal(svd->ds,DS_MAT_D,&omega));
643:     PetscCall(BVSetActiveColumns(V,svd->nconv,nv));
644:     PetscCall(BVSetActiveColumns(U,svd->nconv,nv));

646:     /* solve projected problem */
647:     PetscCall(DSSetDimensions(svd->ds,nv,svd->nconv,svd->nconv+l));
648:     PetscCall(DSHSVDSetDimensions(svd->ds,nv));
649:     PetscCall(DSSetState(svd->ds,l?DS_STATE_RAW:DS_STATE_INTERMEDIATE));
650:     PetscCall(DSSolve(svd->ds,w,NULL));
651:     PetscCall(DSSort(svd->ds,w,NULL,NULL,NULL,NULL));
652:     PetscCall(DSUpdateExtraRow(svd->ds));
653:     PetscCall(DSSynchronize(svd->ds,w,NULL));
654:     PetscCall(DSGetArrayReal(svd->ds,DS_MAT_D,&omega));
655:     for (i=svd->nconv;i<nv;i++) {
656:       svd->sigma[i] = PetscRealPart(w[i]);
657:       svd->sign[i] = omega[i];
658:     }
659:     PetscCall(DSRestoreArrayReal(svd->ds,DS_MAT_D,&omega));

661:     /* check convergence */
662:     PetscCall(SVDKrylovConvergence(svd,PETSC_FALSE,svd->nconv,nv-svd->nconv,1.0,&k));
663:     PetscCall((*svd->stopping)(svd,svd->its,svd->max_it,k,svd->nsv,&svd->reason,svd->stoppingctx));

665:     /* update l */
666:     if (svd->reason != SVD_CONVERGED_ITERATING || breakdown || k==nv) l = 0;
667:     else l = PetscMax(1,(PetscInt)((nv-k)*lanczos->keep));
668:     if (!lanczos->lock && l>0) { l += k; k = 0; } /* non-locking variant: reset no. of converged triplets */
669:     if (l) PetscCall(PetscInfo(svd,"Preparing to restart keeping l=%" PetscInt_FMT " vectors\n",l));

671:     if (svd->reason == SVD_CONVERGED_ITERATING) {
672:       if (PetscUnlikely(breakdown || k==nv)) {
673:         /* Start a new bidiagonalization */
674:         PetscCall(PetscInfo(svd,"Breakdown in bidiagonalization (it=%" PetscInt_FMT ")\n",svd->its));
675:         if (k<svd->nsv) {
676:           PetscCall(BVSetRandomColumn(V,k));
677:           PetscCall(BVOrthonormalizeColumn(V,k,PETSC_FALSE,NULL,&breakdown));
678:           if (breakdown) {
679:             svd->reason = SVD_DIVERGED_BREAKDOWN;
680:             PetscCall(PetscInfo(svd,"Unable to generate more start vectors\n"));
681:           }
682:         }
683:       } else PetscCall(DSTruncate(svd->ds,k+l,PETSC_FALSE));
684:     }

686:     /* compute converged singular vectors and restart vectors */
687:     PetscCall(DSGetMat(svd->ds,DS_MAT_V,&VV));
688:     PetscCall(BVMultInPlace(V,VV,svd->nconv,k+l));
689:     PetscCall(DSRestoreMat(svd->ds,DS_MAT_V,&VV));
690:     PetscCall(DSGetMat(svd->ds,DS_MAT_U,&UU));
691:     PetscCall(BVMultInPlace(U,UU,svd->nconv,k+l));
692:     PetscCall(DSRestoreMat(svd->ds,DS_MAT_U,&UU));

694:     /* copy the last vector of V to be the next initial vector
695:        and change signature matrix of U */
696:     if (svd->reason == SVD_CONVERGED_ITERATING && !breakdown) {
697:       PetscCall(BVCopyColumn(V,nv,k+l));
698:       PetscCall(BVSetActiveColumns(U,0,k+l));
699:       PetscCall(DSGetMatAndColumn(svd->ds,DS_MAT_D,0,&D,&vomega));
700:       PetscCall(BVSetSignature(U,vomega));
701:       PetscCall(DSRestoreMatAndColumn(svd->ds,DS_MAT_D,0,&D,&vomega));
702:     }

704:     svd->nconv = k;
705:     PetscCall(SVDMonitor(svd,svd->its,svd->nconv,svd->sigma,svd->errest,nv));
706:   }

708:   /* free working space */
709:   PetscCall(PetscFree(w));
710:   PetscCall(DSTruncate(svd->ds,svd->nconv,PETSC_TRUE));
711:   PetscFunctionReturn(PETSC_SUCCESS);
712: }

714: /* Given n computed generalized singular values in sigmain, backtransform them
715:    in sigmaout by undoing scaling and reciprocating if swapped=true. Also updates vectors V
716:    if given. If sigmaout=NULL then the result overwrites sigmain. */
717: static PetscErrorCode SVDLanczosBackTransform(SVD svd,PetscInt n,PetscReal *sigmain,PetscReal *sigmaout,BV V)
718: {
719:   SVD_TRLANCZOS *lanczos = (SVD_TRLANCZOS*)svd->data;
720:   PetscInt      i;
721:   PetscReal     c,s,r,f,scalef;

723:   PetscFunctionBegin;
724:   scalef = svd->swapped? 1.0/lanczos->scalef: lanczos->scalef;
725:   for (i=0;i<n;i++) {
726:     if (V && scalef != 1.0) {
727:       s = 1.0/PetscSqrtReal(1.0+sigmain[i]*sigmain[i]);
728:       c = sigmain[i]*s;
729:       r = s/scalef;
730:       f = 1.0/PetscSqrtReal(c*c+r*r);
731:       PetscCall(BVScaleColumn(V,i,f));
732:     }
733:     if (sigmaout) {
734:       if (svd->swapped) sigmaout[i] = 1.0/(sigmain[i]*scalef);
735:       else sigmaout[i] = sigmain[i]*scalef;
736:     } else {
737:       sigmain[i] *= scalef;
738:       if (svd->swapped) sigmain[i] = 1.0/sigmain[i];
739:     }
740:   }
741:   PetscFunctionReturn(PETSC_SUCCESS);
742: }

744: static PetscErrorCode SVDLanczosGSingle(SVD svd,PetscReal *alpha,PetscReal *beta,Mat Z,BV V,BV U,KSP ksp,PetscInt k,PetscInt *n,PetscBool *breakdown)
745: {
746:   SVD_TRLANCZOS     *lanczos = (SVD_TRLANCZOS*)svd->data;
747:   PetscInt          i,j,m;
748:   const PetscScalar *carr;
749:   PetscScalar       *arr;
750:   Vec               u,v,ut=svd->workl[0],x=svd->workr[0],v1,u1,u2;
751:   PetscBool         lindep=PETSC_FALSE;

753:   PetscFunctionBegin;
754:   PetscCall(MatCreateVecsEmpty(svd->A,NULL,&v1));
755:   PetscCall(BVGetColumn(V,k,&v));
756:   PetscCall(BVGetColumn(U,k,&u));

758:   /* Form ut=[u;0] */
759:   PetscCall(VecZeroEntries(ut));
760:   PetscCall(VecGetLocalSize(u,&m));
761:   PetscCall(VecGetArrayRead(u,&carr));
762:   PetscCall(VecGetArray(ut,&arr));
763:   for (j=0; j<m; j++) arr[j] = carr[j];
764:   PetscCall(VecRestoreArrayRead(u,&carr));
765:   PetscCall(VecRestoreArray(ut,&arr));

767:   /* Solve least squares problem */
768:   PetscCall(KSPSolve(ksp,ut,x));

770:   PetscCall(MatMult(Z,x,v));

772:   PetscCall(BVRestoreColumn(U,k,&u));
773:   PetscCall(BVRestoreColumn(V,k,&v));
774:   PetscCall(BVOrthonormalizeColumn(V,k,PETSC_FALSE,alpha+k,&lindep));
775:   if (PetscUnlikely(lindep)) {
776:     *n = k;
777:     if (breakdown) *breakdown = lindep;
778:     PetscFunctionReturn(PETSC_SUCCESS);
779:   }

781:   for (i=k+1; i<*n; i++) {

783:     /* Compute vector i of BV U */
784:     PetscCall(BVGetColumn(V,i-1,&v));
785:     PetscCall(VecGetArray(v,&arr));
786:     PetscCall(VecPlaceArray(v1,arr));
787:     PetscCall(VecRestoreArray(v,&arr));
788:     PetscCall(BVRestoreColumn(V,i-1,&v));
789:     PetscCall(BVInsertVec(U,i,v1));
790:     PetscCall(VecResetArray(v1));
791:     PetscCall(BVOrthonormalizeColumn(U,i,PETSC_FALSE,beta+i-1,&lindep));
792:     if (PetscUnlikely(lindep)) {
793:       *n = i;
794:       break;
795:     }

797:     /* Compute vector i of BV V */

799:     PetscCall(BVGetColumn(V,i,&v));
800:     PetscCall(BVGetColumn(U,i,&u));

802:     /* Form ut=[u;0] */
803:     PetscCall(VecGetArrayRead(u,&carr));
804:     PetscCall(VecGetArray(ut,&arr));
805:     for (j=0; j<m; j++) arr[j] = carr[j];
806:     PetscCall(VecRestoreArrayRead(u,&carr));
807:     PetscCall(VecRestoreArray(ut,&arr));

809:     /* Solve least squares problem */
810:     PetscCall(KSPSolve(ksp,ut,x));

812:     PetscCall(MatMult(Z,x,v));

814:     PetscCall(BVRestoreColumn(U,i,&u));
815:     PetscCall(BVRestoreColumn(V,i,&v));
816:     if (!lanczos->oneside || i==k+1) PetscCall(BVOrthonormalizeColumn(V,i,PETSC_FALSE,alpha+i,&lindep));
817:     else {  /* cheap computation of V[i], if restart (i==k+1) do a full reorthogonalization */
818:       PetscCall(BVGetColumn(V,i,&u2));
819:       PetscCall(BVGetColumn(V,i-1,&u1));
820:       PetscCall(VecAXPY(u2,-beta[i-1],u1));
821:       PetscCall(BVRestoreColumn(V,i-1,&u1));
822:       PetscCall(VecNorm(u2,NORM_2,&alpha[i]));
823:       if (alpha[i]==0.0) lindep = PETSC_TRUE;
824:       else PetscCall(VecScale(u2,1.0/alpha[i]));
825:       PetscCall(BVRestoreColumn(V,i,&u2));
826:     }
827:     if (PetscUnlikely(lindep)) {
828:       *n = i;
829:       break;
830:     }
831:   }

833:   /* Compute vector n of BV U */
834:   if (!lindep) {
835:     PetscCall(BVGetColumn(V,*n-1,&v));
836:     PetscCall(VecGetArray(v,&arr));
837:     PetscCall(VecPlaceArray(v1,arr));
838:     PetscCall(VecRestoreArray(v,&arr));
839:     PetscCall(BVRestoreColumn(V,*n-1,&v));
840:     PetscCall(BVInsertVec(U,*n,v1));
841:     PetscCall(VecResetArray(v1));
842:     PetscCall(BVOrthonormalizeColumn(U,*n,PETSC_FALSE,beta+*n-1,&lindep));
843:   }
844:   if (breakdown) *breakdown = lindep;
845:   PetscCall(VecDestroy(&v1));
846:   PetscFunctionReturn(PETSC_SUCCESS);
847: }

849: /* solve generalized problem with single bidiagonalization of Q_A */
850: static PetscErrorCode SVDSolve_TRLanczosGSingle(SVD svd,BV U1,BV V)
851: {
852:   SVD_TRLANCZOS  *lanczos = (SVD_TRLANCZOS*)svd->data;
853:   PetscReal      *alpha,*beta,normr,scaleth,sigma0,*sigma;
854:   PetscScalar    *w;
855:   PetscInt       i,k,l,nv,ld;
856:   Mat            U,VV;
857:   PetscBool      breakdown=PETSC_FALSE;

859:   PetscFunctionBegin;
860:   PetscCall(DSGetLeadingDimension(svd->ds,&ld));
861:   PetscCall(PetscMalloc2(ld,&w,ld,&sigma));
862:   normr = (svd->conv==SVD_CONV_ABS)? PetscMax(svd->nrma,svd->nrmb*lanczos->scalef): 1.0;
863:   /* Convert scale threshold th=c/s to the corresponding c */
864:   scaleth = (lanczos->scaleth!=0)? lanczos->scaleth/PetscSqrtReal(lanczos->scaleth*lanczos->scaleth+1): 0.0;

866:   /* normalize start vector */
867:   if (!svd->ninil) {
868:     PetscCall(BVSetRandomColumn(U1,0));
869:     PetscCall(BVOrthonormalizeColumn(U1,0,PETSC_TRUE,NULL,NULL));
870:   }

872:   l = 0;
873:   while (svd->reason == SVD_CONVERGED_ITERATING) {
874:     svd->its++;

876:     /* inner loop */
877:     nv = PetscMin(svd->nconv+svd->mpd,svd->ncv);
878:     PetscCall(DSGetArrayReal(svd->ds,DS_MAT_T,&alpha));
879:     beta = alpha + ld;
880:     PetscCall(SVDLanczosGSingle(svd,alpha,beta,lanczos->Z,V,U1,lanczos->ksp,svd->nconv+l,&nv,&breakdown));
881:     PetscCall(DSRestoreArrayReal(svd->ds,DS_MAT_T,&alpha));
882:     PetscCall(BVSetActiveColumns(V,svd->nconv,nv));
883:     PetscCall(BVSetActiveColumns(U1,svd->nconv,nv));

885:     /* solve projected problem */
886:     PetscCall(DSSetDimensions(svd->ds,nv,svd->nconv,svd->nconv+l));
887:     PetscCall(DSSVDSetDimensions(svd->ds,nv));
888:     PetscCall(DSSetState(svd->ds,l?DS_STATE_RAW:DS_STATE_INTERMEDIATE));
889:     PetscCall(DSSolve(svd->ds,w,NULL));
890:     PetscCall(DSSort(svd->ds,w,NULL,NULL,NULL,NULL));
891:     PetscCall(DSUpdateExtraRow(svd->ds));
892:     PetscCall(DSSynchronize(svd->ds,w,NULL));
893:     for (i=svd->nconv;i<nv;i++) svd->sigma[i] = PetscRealPart(w[i]);

895:     /* check convergence */
896:     PetscCall(SVDKrylovConvergence(svd,PETSC_FALSE,svd->nconv,nv-svd->nconv,normr,&k));
897:     PetscCall((*svd->stopping)(svd,svd->its,svd->max_it,k,svd->nsv,&svd->reason,svd->stoppingctx));

899:     sigma0 = svd->which==SVD_LARGEST? svd->sigma[0] : 1.0/svd->sigma[0];
900:     if (scaleth!=0 && k==0 && sigma0>scaleth) {

902:       /* Scale and start from scratch */
903:       lanczos->scalef *= svd->sigma[0]/PetscSqrtReal(1-svd->sigma[0]*svd->sigma[0]);
904:       PetscCall(PetscInfo(svd,"Scaling by factor %g and starting from scratch\n",(double)lanczos->scalef));
905:       PetscCall(MatZUpdateScale(svd));
906:       if (svd->conv==SVD_CONV_ABS) normr = PetscMax(svd->nrma,svd->nrmb*lanczos->scalef);
907:       l = 0;

909:     } else {

911:       /* update l */
912:       if (svd->reason != SVD_CONVERGED_ITERATING || breakdown || k==nv) l = 0;
913:       else l = PetscMax(1,(PetscInt)((nv-k)*lanczos->keep));
914:       if (!lanczos->lock && l>0) { l += k; k = 0; } /* non-locking variant: reset no. of converged triplets */
915:       if (l) PetscCall(PetscInfo(svd,"Preparing to restart keeping l=%" PetscInt_FMT " vectors\n",l));

917:       if (svd->reason == SVD_CONVERGED_ITERATING) {
918:         if (PetscUnlikely(breakdown || k==nv)) {
919:           /* Start a new bidiagonalization */
920:           PetscCall(PetscInfo(svd,"Breakdown in bidiagonalization (it=%" PetscInt_FMT ")\n",svd->its));
921:           if (k<svd->nsv) {
922:             PetscCall(BVSetRandomColumn(U1,k));
923:             PetscCall(BVOrthonormalizeColumn(U1,k,PETSC_FALSE,NULL,&breakdown));
924:             if (breakdown) {
925:               svd->reason = SVD_DIVERGED_BREAKDOWN;
926:               PetscCall(PetscInfo(svd,"Unable to generate more start vectors\n"));
927:             }
928:           }
929:         } else PetscCall(DSTruncate(svd->ds,k+l,PETSC_FALSE));
930:       }

932:       /* compute converged singular vectors and restart vectors */
933:       PetscCall(DSGetMat(svd->ds,DS_MAT_U,&U));
934:       PetscCall(BVMultInPlace(V,U,svd->nconv,k+l));
935:       PetscCall(DSRestoreMat(svd->ds,DS_MAT_U,&U));
936:       PetscCall(DSGetMat(svd->ds,DS_MAT_V,&VV));
937:       PetscCall(BVMultInPlace(U1,VV,svd->nconv,k+l));
938:       PetscCall(DSRestoreMat(svd->ds,DS_MAT_V,&VV));

940:       /* copy the last vector to be the next initial vector */
941:       if (svd->reason == SVD_CONVERGED_ITERATING && !breakdown) PetscCall(BVCopyColumn(U1,nv,k+l));
942:     }

944:     svd->nconv = k;
945:     PetscCall(SVDLanczosBackTransform(svd,nv,svd->sigma,sigma,NULL));
946:     PetscCall(SVDMonitor(svd,svd->its,svd->nconv,sigma,svd->errest,nv));
947:   }

949:   PetscCall(PetscFree2(w,sigma));
950:   PetscFunctionReturn(PETSC_SUCCESS);
951: }

953: /* Move generalized left singular vectors (0..nconv) from U1 and U2 to its final destination svd->U (single variant) */
954: static inline PetscErrorCode SVDLeftSingularVectors_Single(SVD svd,BV U1,BV U2)
955: {
956:   PetscInt          i,k,m,p;
957:   Vec               u,u1,u2;
958:   PetscScalar       *ua,*u2a;
959:   const PetscScalar *u1a;
960:   PetscReal         s;

962:   PetscFunctionBegin;
963:   PetscCall(MatGetLocalSize(svd->A,&m,NULL));
964:   PetscCall(MatGetLocalSize(svd->B,&p,NULL));
965:   for (i=0;i<svd->nconv;i++) {
966:     PetscCall(BVGetColumn(U1,i,&u1));
967:     PetscCall(BVGetColumn(U2,i,&u2));
968:     PetscCall(BVGetColumn(svd->U,i,&u));
969:     PetscCall(VecGetArrayRead(u1,&u1a));
970:     PetscCall(VecGetArray(u,&ua));
971:     PetscCall(VecGetArray(u2,&u2a));
972:     /* Copy column from U1 to upper part of u */
973:     for (k=0;k<m;k++) ua[k] = u1a[k];
974:     /* Copy column from lower part of U to U2. Orthogonalize column in U2 and copy back to U */
975:     for (k=0;k<p;k++) u2a[k] = ua[m+k];
976:     PetscCall(VecRestoreArray(u2,&u2a));
977:     PetscCall(BVRestoreColumn(U2,i,&u2));
978:     PetscCall(BVOrthonormalizeColumn(U2,i,PETSC_FALSE,&s,NULL));
979:     PetscCall(BVGetColumn(U2,i,&u2));
980:     PetscCall(VecGetArray(u2,&u2a));
981:     for (k=0;k<p;k++) ua[m+k] = u2a[k];
982:     /* Update singular value */
983:     svd->sigma[i] /= s;
984:     PetscCall(VecRestoreArrayRead(u1,&u1a));
985:     PetscCall(VecRestoreArray(u,&ua));
986:     PetscCall(VecRestoreArray(u2,&u2a));
987:     PetscCall(BVRestoreColumn(U1,i,&u1));
988:     PetscCall(BVRestoreColumn(U2,i,&u2));
989:     PetscCall(BVRestoreColumn(svd->U,i,&u));
990:   }
991:   PetscFunctionReturn(PETSC_SUCCESS);
992: }

994: static PetscErrorCode SVDLanczosGUpper(SVD svd,PetscReal *alpha,PetscReal *beta,PetscReal *alphah,PetscReal *betah,Mat Z,BV U1,BV U2,BV V,KSP ksp,PetscInt k,PetscInt *n,PetscBool *breakdown)
995: {
996:   SVD_TRLANCZOS     *lanczos = (SVD_TRLANCZOS*)svd->data;
997:   PetscInt          i,j,m,p;
998:   const PetscScalar *carr;
999:   PetscScalar       *arr,*u2arr;
1000:   Vec               u,v,ut=svd->workl[0],x=svd->workr[0],v1,u1,u2;
1001:   PetscBool         lindep=PETSC_FALSE,lindep1=PETSC_FALSE,lindep2=PETSC_FALSE;

1003:   PetscFunctionBegin;
1004:   PetscCall(MatCreateVecsEmpty(svd->A,NULL,&v1));
1005:   PetscCall(MatGetLocalSize(svd->A,&m,NULL));
1006:   PetscCall(MatGetLocalSize(svd->B,&p,NULL));

1008:   for (i=k; i<*n; i++) {
1009:     /* Compute vector i of BV U1 */
1010:     PetscCall(BVGetColumn(V,i,&v));
1011:     PetscCall(VecGetArrayRead(v,&carr));
1012:     PetscCall(VecPlaceArray(v1,carr));
1013:     PetscCall(BVInsertVec(U1,i,v1));
1014:     PetscCall(VecResetArray(v1));
1015:     if (!lanczos->oneside || i==k) PetscCall(BVOrthonormalizeColumn(U1,i,PETSC_FALSE,alpha+i,&lindep1));
1016:     else {  /* cheap computation of U1[i], if restart (i==k) do a full reorthogonalization */
1017:       PetscCall(BVGetColumn(U1,i,&u2));
1018:       if (i>0) {
1019:         PetscCall(BVGetColumn(U1,i-1,&u1));
1020:         PetscCall(VecAXPY(u2,-beta[i-1],u1));
1021:         PetscCall(BVRestoreColumn(U1,i-1,&u1));
1022:       }
1023:       PetscCall(VecNorm(u2,NORM_2,&alpha[i]));
1024:       if (alpha[i]==0.0) lindep = PETSC_TRUE;
1025:       else PetscCall(VecScale(u2,1.0/alpha[i]));
1026:       PetscCall(BVRestoreColumn(U1,i,&u2));
1027:     }

1029:     /* Compute vector i of BV U2 */
1030:     PetscCall(BVGetColumn(U2,i,&u2));
1031:     PetscCall(VecGetArray(u2,&u2arr));
1032:     if (i%2) {
1033:       for (j=0; j<p; j++) u2arr[j] = -carr[m+j];
1034:     } else {
1035:       for (j=0; j<p; j++) u2arr[j] = carr[m+j];
1036:     }
1037:     PetscCall(VecRestoreArray(u2,&u2arr));
1038:     PetscCall(VecRestoreArrayRead(v,&carr));
1039:     PetscCall(BVRestoreColumn(V,i,&v));
1040:     if (lanczos->oneside && i>k) {  /* cheap computation of U2[i], if restart (i==k) do a full reorthogonalization */
1041:       if (i>0) {
1042:         PetscCall(BVGetColumn(U2,i-1,&u1));
1043:         PetscCall(VecAXPY(u2,(i%2)?betah[i-1]:-betah[i-1],u1));
1044:         PetscCall(BVRestoreColumn(U2,i-1,&u1));
1045:       }
1046:       PetscCall(VecNorm(u2,NORM_2,&alphah[i]));
1047:       if (alphah[i]==0.0) lindep = PETSC_TRUE;
1048:       else PetscCall(VecScale(u2,1.0/alphah[i]));
1049:     }
1050:     PetscCall(BVRestoreColumn(U2,i,&u2));
1051:     if (!lanczos->oneside || i==k) PetscCall(BVOrthonormalizeColumn(U2,i,PETSC_FALSE,alphah+i,&lindep2));
1052:     if (i%2) alphah[i] = -alphah[i];
1053:     if (PetscUnlikely(lindep1 || lindep2)) {
1054:       lindep = PETSC_TRUE;
1055:       *n = i;
1056:       break;
1057:     }

1059:     /* Compute vector i+1 of BV V */
1060:     PetscCall(BVGetColumn(V,i+1,&v));
1061:     /* Form ut=[u;0] */
1062:     PetscCall(BVGetColumn(U1,i,&u));
1063:     PetscCall(VecZeroEntries(ut));
1064:     PetscCall(VecGetArrayRead(u,&carr));
1065:     PetscCall(VecGetArray(ut,&arr));
1066:     for (j=0; j<m; j++) arr[j] = carr[j];
1067:     PetscCall(VecRestoreArrayRead(u,&carr));
1068:     PetscCall(VecRestoreArray(ut,&arr));
1069:     /* Solve least squares problem */
1070:     PetscCall(KSPSolve(ksp,ut,x));
1071:     PetscCall(MatMult(Z,x,v));
1072:     PetscCall(BVRestoreColumn(U1,i,&u));
1073:     PetscCall(BVRestoreColumn(V,i+1,&v));
1074:     PetscCall(BVOrthonormalizeColumn(V,i+1,PETSC_FALSE,beta+i,&lindep));
1075:     betah[i] = -alpha[i]*beta[i]/alphah[i];
1076:     if (PetscUnlikely(lindep)) {
1077:       *n = i;
1078:       break;
1079:     }
1080:   }
1081:   if (breakdown) *breakdown = lindep;
1082:   PetscCall(VecDestroy(&v1));
1083:   PetscFunctionReturn(PETSC_SUCCESS);
1084: }

1086: /* generate random initial vector in column k for joint upper-upper bidiagonalization */
1087: static inline PetscErrorCode SVDInitialVectorGUpper(SVD svd,BV V,BV U1,PetscInt k,PetscBool *breakdown)
1088: {
1089:   SVD_TRLANCZOS     *lanczos = (SVD_TRLANCZOS*)svd->data;
1090:   Vec               u,v,ut=svd->workl[0],x=svd->workr[0];
1091:   PetscInt          m,j;
1092:   PetscScalar       *arr;
1093:   const PetscScalar *carr;

1095:   PetscFunctionBegin;
1096:   /* Form ut=[u;0] where u is the k-th column of U1 */
1097:   PetscCall(VecZeroEntries(ut));
1098:   PetscCall(BVGetColumn(U1,k,&u));
1099:   PetscCall(VecGetLocalSize(u,&m));
1100:   PetscCall(VecGetArrayRead(u,&carr));
1101:   PetscCall(VecGetArray(ut,&arr));
1102:   for (j=0; j<m; j++) arr[j] = carr[j];
1103:   PetscCall(VecRestoreArrayRead(u,&carr));
1104:   PetscCall(VecRestoreArray(ut,&arr));
1105:   PetscCall(BVRestoreColumn(U1,k,&u));
1106:   /* Solve least squares problem Z*x=ut for x. Then set v=Z*x */
1107:   PetscCall(KSPSolve(lanczos->ksp,ut,x));
1108:   PetscCall(BVGetColumn(V,k,&v));
1109:   PetscCall(MatMult(lanczos->Z,x,v));
1110:   PetscCall(BVRestoreColumn(V,k,&v));
1111:   if (breakdown) PetscCall(BVOrthonormalizeColumn(V,k,PETSC_FALSE,NULL,breakdown));
1112:   else PetscCall(BVOrthonormalizeColumn(V,k,PETSC_TRUE,NULL,NULL));
1113:   PetscFunctionReturn(PETSC_SUCCESS);
1114: }

1116: /* solve generalized problem with joint upper-upper bidiagonalization */
1117: static PetscErrorCode SVDSolve_TRLanczosGUpper(SVD svd,BV U1,BV U2,BV V)
1118: {
1119:   SVD_TRLANCZOS  *lanczos = (SVD_TRLANCZOS*)svd->data;
1120:   PetscReal      *alpha,*beta,*alphah,*betah,normr,sigma0,*sigma;
1121:   PetscScalar    *w;
1122:   PetscInt       i,k,l,nv,ld;
1123:   Mat            U,Vmat,X;
1124:   PetscBool      breakdown=PETSC_FALSE;

1126:   PetscFunctionBegin;
1127:   PetscCall(DSGetLeadingDimension(svd->ds,&ld));
1128:   PetscCall(PetscMalloc2(ld,&w,ld,&sigma));
1129:   normr = (svd->conv==SVD_CONV_ABS)? PetscMax(svd->nrma,svd->nrmb*lanczos->scalef): 1.0;

1131:   /* normalize start vector */
1132:   if (!svd->ninil) PetscCall(BVSetRandomColumn(U1,0));
1133:   PetscCall(SVDInitialVectorGUpper(svd,V,U1,0,NULL));

1135:   l = 0;
1136:   while (svd->reason == SVD_CONVERGED_ITERATING) {
1137:     svd->its++;

1139:     /* inner loop */
1140:     nv = PetscMin(svd->nconv+svd->mpd,svd->ncv);
1141:     PetscCall(DSGetArrayReal(svd->ds,DS_MAT_T,&alpha));
1142:     PetscCall(DSGetArrayReal(svd->ds,DS_MAT_D,&alphah));
1143:     beta = alpha + ld;
1144:     betah = alpha + 2*ld;
1145:     PetscCall(SVDLanczosGUpper(svd,alpha,beta,alphah,betah,lanczos->Z,U1,U2,V,lanczos->ksp,svd->nconv+l,&nv,&breakdown));
1146:     PetscCall(DSRestoreArrayReal(svd->ds,DS_MAT_T,&alpha));
1147:     PetscCall(DSRestoreArrayReal(svd->ds,DS_MAT_D,&alphah));
1148:     PetscCall(BVSetActiveColumns(V,svd->nconv,nv));
1149:     PetscCall(BVSetActiveColumns(U1,svd->nconv,nv));
1150:     PetscCall(BVSetActiveColumns(U2,svd->nconv,nv));

1152:     /* solve projected problem */
1153:     PetscCall(DSSetDimensions(svd->ds,nv,svd->nconv,svd->nconv+l));
1154:     PetscCall(DSGSVDSetDimensions(svd->ds,nv,nv));
1155:     PetscCall(DSSetState(svd->ds,l?DS_STATE_RAW:DS_STATE_INTERMEDIATE));
1156:     PetscCall(DSSolve(svd->ds,w,NULL));
1157:     PetscCall(DSSort(svd->ds,w,NULL,NULL,NULL,NULL));
1158:     PetscCall(DSUpdateExtraRow(svd->ds));
1159:     PetscCall(DSSynchronize(svd->ds,w,NULL));
1160:     for (i=svd->nconv;i<nv;i++) svd->sigma[i] = PetscRealPart(w[i]);

1162:     /* check convergence */
1163:     PetscCall(SVDKrylovConvergence(svd,PETSC_FALSE,svd->nconv,nv-svd->nconv,normr,&k));
1164:     PetscCall((*svd->stopping)(svd,svd->its,svd->max_it,k,svd->nsv,&svd->reason,svd->stoppingctx));

1166:     sigma0 = svd->which==SVD_LARGEST? svd->sigma[0] : 1.0/svd->sigma[0];
1167:     if (lanczos->scaleth!=0 && k==0 && sigma0>lanczos->scaleth) {

1169:       /* Scale and start from scratch */
1170:       lanczos->scalef *= svd->sigma[0];
1171:       PetscCall(PetscInfo(svd,"Scaling by factor %g and starting from scratch\n",(double)lanczos->scalef));
1172:       PetscCall(MatZUpdateScale(svd));
1173:       if (svd->conv==SVD_CONV_ABS) normr = PetscMax(svd->nrma,svd->nrmb*lanczos->scalef);
1174:       l = 0;
1175:       if (!svd->ninil) PetscCall(BVSetRandomColumn(U1,0));
1176:       PetscCall(SVDInitialVectorGUpper(svd,V,U1,0,NULL));

1178:     } else {

1180:       /* update l */
1181:       if (svd->reason != SVD_CONVERGED_ITERATING || breakdown || k==nv) l = 0;
1182:       else l = PetscMax(1,(PetscInt)((nv-k)*lanczos->keep));
1183:       if (!lanczos->lock && l>0) { l += k; k = 0; } /* non-locking variant: reset no. of converged triplets */
1184:       if (l) PetscCall(PetscInfo(svd,"Preparing to restart keeping l=%" PetscInt_FMT " vectors\n",l));

1186:       if (svd->reason == SVD_CONVERGED_ITERATING) {
1187:         if (PetscUnlikely(breakdown || k==nv)) {
1188:           /* Start a new bidiagonalization */
1189:           PetscCall(PetscInfo(svd,"Breakdown in bidiagonalization (it=%" PetscInt_FMT ")\n",svd->its));
1190:           if (k<svd->nsv) {
1191:             PetscCall(BVSetRandomColumn(U1,k));
1192:             PetscCall(SVDInitialVectorGUpper(svd,V,U1,k,&breakdown));
1193:             if (breakdown) {
1194:               svd->reason = SVD_DIVERGED_BREAKDOWN;
1195:               PetscCall(PetscInfo(svd,"Unable to generate more start vectors\n"));
1196:             }
1197:           }
1198:         } else PetscCall(DSTruncate(svd->ds,k+l,PETSC_FALSE));
1199:       }
1200:       /* compute converged singular vectors and restart vectors */
1201:       PetscCall(DSGetMat(svd->ds,DS_MAT_X,&X));
1202:       PetscCall(BVMultInPlace(V,X,svd->nconv,k+l));
1203:       PetscCall(DSRestoreMat(svd->ds,DS_MAT_X,&X));
1204:       PetscCall(DSGetMat(svd->ds,DS_MAT_U,&U));
1205:       PetscCall(BVMultInPlace(U1,U,svd->nconv,k+l));
1206:       PetscCall(DSRestoreMat(svd->ds,DS_MAT_U,&U));
1207:       PetscCall(DSGetMat(svd->ds,DS_MAT_V,&Vmat));
1208:       PetscCall(BVMultInPlace(U2,Vmat,svd->nconv,k+l));
1209:       PetscCall(DSRestoreMat(svd->ds,DS_MAT_V,&Vmat));

1211:       /* copy the last vector to be the next initial vector */
1212:       if (svd->reason == SVD_CONVERGED_ITERATING && !breakdown) PetscCall(BVCopyColumn(V,nv,k+l));
1213:     }

1215:     svd->nconv = k;
1216:     PetscCall(SVDLanczosBackTransform(svd,nv,svd->sigma,sigma,NULL));
1217:     PetscCall(SVDMonitor(svd,svd->its,svd->nconv,sigma,svd->errest,nv));
1218:   }

1220:   PetscCall(PetscFree2(w,sigma));
1221:   PetscFunctionReturn(PETSC_SUCCESS);
1222: }

1224: /* Move generalized left singular vectors (0..nconv) from U1 and U2 to its final destination svd->U (upper and lower variants) */
1225: static inline PetscErrorCode SVDLeftSingularVectors(SVD svd,BV U1,BV U2)
1226: {
1227:   PetscInt          i,k,m,p;
1228:   Vec               u,u1,u2;
1229:   PetscScalar       *ua;
1230:   const PetscScalar *u1a,*u2a;

1232:   PetscFunctionBegin;
1233:   PetscCall(BVGetSizes(U1,&m,NULL,NULL));
1234:   PetscCall(BVGetSizes(U2,&p,NULL,NULL));
1235:   for (i=0;i<svd->nconv;i++) {
1236:     PetscCall(BVGetColumn(U1,i,&u1));
1237:     PetscCall(BVGetColumn(U2,i,&u2));
1238:     PetscCall(BVGetColumn(svd->U,i,&u));
1239:     PetscCall(VecGetArrayRead(u1,&u1a));
1240:     PetscCall(VecGetArrayRead(u2,&u2a));
1241:     PetscCall(VecGetArray(u,&ua));
1242:     /* Copy column from u1 to upper part of u */
1243:     for (k=0;k<m;k++) ua[k] = u1a[k];
1244:     /* Copy column from u2 to lower part of u */
1245:     for (k=0;k<p;k++) ua[m+k] = u2a[k];
1246:     PetscCall(VecRestoreArrayRead(u1,&u1a));
1247:     PetscCall(VecRestoreArrayRead(u2,&u2a));
1248:     PetscCall(VecRestoreArray(u,&ua));
1249:     PetscCall(BVRestoreColumn(U1,i,&u1));
1250:     PetscCall(BVRestoreColumn(U2,i,&u2));
1251:     PetscCall(BVRestoreColumn(svd->U,i,&u));
1252:   }
1253:   PetscFunctionReturn(PETSC_SUCCESS);
1254: }

1256: static PetscErrorCode SVDLanczosGLower(SVD svd,PetscReal *alpha,PetscReal *beta,PetscReal *alphah,PetscReal *betah,Mat Z,BV U1,BV U2,BV V,KSP ksp,PetscInt k,PetscInt *n,PetscBool *breakdown)
1257: {
1258:   SVD_TRLANCZOS     *lanczos = (SVD_TRLANCZOS*)svd->data;
1259:   PetscInt          i,j,m,p;
1260:   const PetscScalar *carr;
1261:   PetscScalar       *arr,*u2arr;
1262:   Vec               u,v,ut=svd->workl[0],x=svd->workr[0],v1,u1,u2;
1263:   PetscBool         lindep=PETSC_FALSE;

1265:   PetscFunctionBegin;
1266:   PetscCall(MatCreateVecsEmpty(svd->A,NULL,&v1));
1267:   PetscCall(MatGetLocalSize(svd->A,&m,NULL));
1268:   PetscCall(MatGetLocalSize(svd->B,&p,NULL));

1270:   for (i=k; i<*n; i++) {
1271:     /* Compute vector i of BV U2 */
1272:     PetscCall(BVGetColumn(V,i,&v));
1273:     PetscCall(VecGetArrayRead(v,&carr));
1274:     PetscCall(BVGetColumn(U2,i,&u2));
1275:     PetscCall(VecGetArray(u2,&u2arr));
1276:     if (i%2) {
1277:       for (j=0; j<p; j++) u2arr[j] = -carr[m+j];
1278:     } else {
1279:       for (j=0; j<p; j++) u2arr[j] = carr[m+j];
1280:     }
1281:     PetscCall(VecRestoreArray(u2,&u2arr));
1282:     if (lanczos->oneside && i>k) {  /* cheap computation of U2[i], if restart (i==k) do a full reorthogonalization */
1283:       if (i>0) {
1284:         PetscCall(BVGetColumn(U2,i-1,&u1));
1285:         PetscCall(VecAXPY(u2,(i%2)?betah[i-1]:-betah[i-1],u1));
1286:         PetscCall(BVRestoreColumn(U2,i-1,&u1));
1287:       }
1288:       PetscCall(VecNorm(u2,NORM_2,&alphah[i]));
1289:       if (alphah[i]==0.0) lindep = PETSC_TRUE;
1290:       else PetscCall(VecScale(u2,1.0/alphah[i]));
1291:     }
1292:     PetscCall(BVRestoreColumn(U2,i,&u2));
1293:     if (!lanczos->oneside || i==k) PetscCall(BVOrthonormalizeColumn(U2,i,PETSC_FALSE,alphah+i,&lindep));
1294:     if (i%2) alphah[i] = -alphah[i];
1295:     if (PetscUnlikely(lindep)) {
1296:       PetscCall(BVRestoreColumn(V,i,&v));
1297:       *n = i;
1298:       break;
1299:     }

1301:     /* Compute vector i+1 of BV U1 */
1302:     PetscCall(VecPlaceArray(v1,carr));
1303:     PetscCall(BVInsertVec(U1,i+1,v1));
1304:     PetscCall(VecResetArray(v1));
1305:     PetscCall(BVOrthonormalizeColumn(U1,i+1,PETSC_FALSE,beta+i,&lindep));
1306:     PetscCall(VecRestoreArrayRead(v,&carr));
1307:     PetscCall(BVRestoreColumn(V,i,&v));
1308:     if (PetscUnlikely(lindep)) {
1309:       *n = i+1;
1310:       break;
1311:     }

1313:     /* Compute vector i+1 of BV V */
1314:     PetscCall(BVGetColumn(V,i+1,&v));
1315:     /* Form ut=[u;0] where u is column i+1 of BV U1 */
1316:     PetscCall(BVGetColumn(U1,i+1,&u));
1317:     PetscCall(VecZeroEntries(ut));
1318:     PetscCall(VecGetArrayRead(u,&carr));
1319:     PetscCall(VecGetArray(ut,&arr));
1320:     for (j=0; j<m; j++) arr[j] = carr[j];
1321:     PetscCall(VecRestoreArrayRead(u,&carr));
1322:     PetscCall(VecRestoreArray(ut,&arr));
1323:     /* Solve least squares problem */
1324:     PetscCall(KSPSolve(ksp,ut,x));
1325:     PetscCall(MatMult(Z,x,v));
1326:     PetscCall(BVRestoreColumn(U1,i+1,&u));
1327:     PetscCall(BVRestoreColumn(V,i+1,&v));
1328:     if (!lanczos->oneside || i==k) PetscCall(BVOrthonormalizeColumn(V,i+1,PETSC_FALSE,alpha+i+1,&lindep));
1329:     else {  /* cheap computation of V[i+1], if restart (i==k) do a full reorthogonalization */
1330:       PetscCall(BVGetColumn(V,i+1,&u2));
1331:       PetscCall(BVGetColumn(V,i,&u1));
1332:       PetscCall(VecAXPY(u2,-beta[i],u1));
1333:       PetscCall(BVRestoreColumn(V,i,&u1));
1334:       PetscCall(VecNorm(u2,NORM_2,&alpha[i+1]));
1335:       if (alpha[i+1]==0.0) lindep = PETSC_TRUE;
1336:       else PetscCall(VecScale(u2,1.0/alpha[i+1]));
1337:       PetscCall(BVRestoreColumn(V,i+1,&u2));
1338:     }
1339:     betah[i] = -alpha[i+1]*beta[i]/alphah[i];
1340:     if (PetscUnlikely(lindep)) {
1341:       *n = i+1;
1342:       break;
1343:     }
1344:   }
1345:   if (breakdown) *breakdown = lindep;
1346:   PetscCall(VecDestroy(&v1));
1347:   PetscFunctionReturn(PETSC_SUCCESS);
1348: }

1350: /* generate random initial vector in column k for joint lower-upper bidiagonalization */
1351: static inline PetscErrorCode SVDInitialVectorGLower(SVD svd,BV V,BV U1,BV U2,PetscInt k,PetscBool *breakdown)
1352: {
1353:   SVD_TRLANCZOS     *lanczos = (SVD_TRLANCZOS*)svd->data;
1354:   const PetscScalar *carr;
1355:   PetscScalar       *arr;
1356:   PetscReal         *alpha;
1357:   PetscInt          j,m,p;
1358:   Vec               u,uh,v,ut=svd->workl[0],x=svd->workr[0];

1360:   PetscFunctionBegin;
1361:   PetscCall(MatGetLocalSize(svd->A,&m,NULL));
1362:   PetscCall(MatGetLocalSize(svd->B,&p,NULL));
1363:   /* Form ut=[0;uh], where uh is the k-th column of U2 */
1364:   PetscCall(BVGetColumn(U2,k,&uh));
1365:   PetscCall(VecZeroEntries(ut));
1366:   PetscCall(VecGetArrayRead(uh,&carr));
1367:   PetscCall(VecGetArray(ut,&arr));
1368:   for (j=0; j<p; j++) arr[m+j] = carr[j];
1369:   PetscCall(VecRestoreArrayRead(uh,&carr));
1370:   PetscCall(VecRestoreArray(ut,&arr));
1371:   PetscCall(BVRestoreColumn(U2,k,&uh));
1372:   /* Solve least squares problem Z*x=ut for x. Then set ut=Z*x */
1373:   PetscCall(KSPSolve(lanczos->ksp,ut,x));
1374:   PetscCall(MatMult(lanczos->Z,x,ut));
1375:   /* Form u, column k of BV U1, as the upper part of ut and orthonormalize */
1376:   PetscCall(MatCreateVecsEmpty(svd->A,NULL,&u));
1377:   PetscCall(VecGetArrayRead(ut,&carr));
1378:   PetscCall(VecPlaceArray(u,carr));
1379:   PetscCall(BVInsertVec(U1,k,u));
1380:   PetscCall(VecResetArray(u));
1381:   PetscCall(VecRestoreArrayRead(ut,&carr));
1382:   PetscCall(VecDestroy(&u));
1383:   if (breakdown) PetscCall(BVOrthonormalizeColumn(U1,k,PETSC_FALSE,NULL,breakdown));
1384:   else PetscCall(BVOrthonormalizeColumn(U1,k,PETSC_TRUE,NULL,NULL));

1386:   if (!breakdown || !*breakdown) {
1387:     PetscCall(MatGetLocalSize(svd->A,&m,NULL));
1388:     /* Compute k-th vector of BV V */
1389:     PetscCall(BVGetColumn(V,k,&v));
1390:     /* Form ut=[u;0] where u is the 1st column of U1 */
1391:     PetscCall(BVGetColumn(U1,k,&u));
1392:     PetscCall(VecZeroEntries(ut));
1393:     PetscCall(VecGetArrayRead(u,&carr));
1394:     PetscCall(VecGetArray(ut,&arr));
1395:     for (j=0; j<m; j++) arr[j] = carr[j];
1396:     PetscCall(VecRestoreArrayRead(u,&carr));
1397:     PetscCall(VecRestoreArray(ut,&arr));
1398:     /* Solve least squares problem */
1399:     PetscCall(KSPSolve(lanczos->ksp,ut,x));
1400:     PetscCall(MatMult(lanczos->Z,x,v));
1401:     PetscCall(BVRestoreColumn(U1,k,&u));
1402:     PetscCall(BVRestoreColumn(V,k,&v));
1403:     PetscCall(DSGetArrayReal(svd->ds,DS_MAT_T,&alpha));
1404:     if (breakdown) PetscCall(BVOrthonormalizeColumn(V,k,PETSC_FALSE,alpha+k,breakdown));
1405:     else PetscCall(BVOrthonormalizeColumn(V,k,PETSC_TRUE,alpha+k,NULL));
1406:     PetscCall(DSRestoreArrayReal(svd->ds,DS_MAT_T,&alpha));
1407:   }
1408:   PetscFunctionReturn(PETSC_SUCCESS);
1409: }

1411: /* solve generalized problem with joint lower-upper bidiagonalization */
1412: static PetscErrorCode SVDSolve_TRLanczosGLower(SVD svd,BV U1,BV U2,BV V)
1413: {
1414:   SVD_TRLANCZOS  *lanczos = (SVD_TRLANCZOS*)svd->data;
1415:   PetscReal      *alpha,*beta,*alphah,*betah,normr,scalef,*sigma,sigma0;
1416:   PetscScalar    *w;
1417:   PetscInt       i,k,l,nv,ld;
1418:   Mat            U,Vmat,X;
1419:   PetscBool      breakdown=PETSC_FALSE,inverted;

1421:   PetscFunctionBegin;
1422:   PetscCall(DSGetLeadingDimension(svd->ds,&ld));
1423:   PetscCall(PetscMalloc2(ld,&w,ld,&sigma));
1424:   inverted = ((svd->which==SVD_LARGEST && svd->swapped) || (svd->which==SVD_SMALLEST && !svd->swapped))? PETSC_TRUE: PETSC_FALSE;
1425:   scalef = svd->swapped? 1.0/lanczos->scalef : lanczos->scalef;
1426:   normr = (svd->conv==SVD_CONV_ABS)? PetscMax(svd->nrma,svd->nrmb*scalef): 1.0;

1428:   /* normalize start vector */
1429:   if (!svd->ninil) PetscCall(BVSetRandomColumn(U2,0));
1430:   PetscCall(SVDInitialVectorGLower(svd,V,U1,U2,0,NULL));

1432:   l = 0;
1433:   while (svd->reason == SVD_CONVERGED_ITERATING) {
1434:     svd->its++;

1436:     /* inner loop */
1437:     nv = PetscMin(svd->nconv+svd->mpd,svd->ncv);
1438:     PetscCall(DSGetArrayReal(svd->ds,DS_MAT_T,&alpha));
1439:     PetscCall(DSGetArrayReal(svd->ds,DS_MAT_D,&alphah));
1440:     beta = alpha + ld;
1441:     betah = alpha + 2*ld;
1442:     PetscCall(SVDLanczosGLower(svd,alpha,beta,alphah,betah,lanczos->Z,U1,U2,V,lanczos->ksp,svd->nconv+l,&nv,&breakdown));
1443:     PetscCall(DSRestoreArrayReal(svd->ds,DS_MAT_T,&alpha));
1444:     PetscCall(DSRestoreArrayReal(svd->ds,DS_MAT_D,&alphah));
1445:     PetscCall(BVSetActiveColumns(V,svd->nconv,nv));
1446:     PetscCall(BVSetActiveColumns(U1,svd->nconv,nv+1));
1447:     PetscCall(BVSetActiveColumns(U2,svd->nconv,nv));

1449:     /* solve projected problem */
1450:     PetscCall(DSSetDimensions(svd->ds,nv+1,svd->nconv,svd->nconv+l));
1451:     PetscCall(DSGSVDSetDimensions(svd->ds,nv,nv));
1452:     PetscCall(DSSetState(svd->ds,l?DS_STATE_RAW:DS_STATE_INTERMEDIATE));
1453:     PetscCall(DSSolve(svd->ds,w,NULL));
1454:     PetscCall(DSSort(svd->ds,w,NULL,NULL,NULL,NULL));
1455:     PetscCall(DSUpdateExtraRow(svd->ds));
1456:     PetscCall(DSSynchronize(svd->ds,w,NULL));
1457:     for (i=svd->nconv;i<nv;i++) svd->sigma[i] = PetscRealPart(w[i]);

1459:     /* check convergence */
1460:     PetscCall(SVDKrylovConvergence(svd,PETSC_FALSE,svd->nconv,nv-svd->nconv,normr,&k));
1461:     PetscCall((*svd->stopping)(svd,svd->its,svd->max_it,k,svd->nsv,&svd->reason,svd->stoppingctx));

1463:     sigma0 = inverted? 1.0/svd->sigma[0] : svd->sigma[0];
1464:     if (lanczos->scaleth!=0 && k==0 && sigma0>lanczos->scaleth) {

1466:       /* Scale and start from scratch */
1467:       lanczos->scalef *= svd->swapped? 1.0/svd->sigma[0] : svd->sigma[0];
1468:       PetscCall(PetscInfo(svd,"Scaling by factor %g and starting from scratch\n",(double)lanczos->scalef));
1469:       PetscCall(MatZUpdateScale(svd));
1470:       scalef = svd->swapped? 1.0/lanczos->scalef : lanczos->scalef;
1471:       if (svd->conv==SVD_CONV_ABS) normr = PetscMax(svd->nrma,svd->nrmb*scalef);
1472:       l = 0;
1473:       if (!svd->ninil) PetscCall(BVSetRandomColumn(U2,0));
1474:       PetscCall(SVDInitialVectorGLower(svd,V,U1,U2,0,NULL));

1476:     } else {

1478:       /* update l */
1479:       if (svd->reason != SVD_CONVERGED_ITERATING || breakdown || k==nv) l = 0;
1480:       else l = PetscMax(1,(PetscInt)((nv-k)*lanczos->keep));
1481:       if (!lanczos->lock && l>0) { l += k; k = 0; } /* non-locking variant: reset no. of converged triplets */
1482:       if (l) PetscCall(PetscInfo(svd,"Preparing to restart keeping l=%" PetscInt_FMT " vectors\n",l));

1484:       if (svd->reason == SVD_CONVERGED_ITERATING) {
1485:         if (PetscUnlikely(breakdown || k==nv)) {
1486:           /* Start a new bidiagonalization */
1487:           PetscCall(PetscInfo(svd,"Breakdown in bidiagonalization (it=%" PetscInt_FMT ")\n",svd->its));
1488:           if (k<svd->nsv) {
1489:             PetscCall(BVSetRandomColumn(U2,k));
1490:             PetscCall(SVDInitialVectorGLower(svd,V,U1,U2,k,&breakdown));
1491:             if (breakdown) {
1492:               svd->reason = SVD_DIVERGED_BREAKDOWN;
1493:               PetscCall(PetscInfo(svd,"Unable to generate more start vectors\n"));
1494:             }
1495:           }
1496:         } else PetscCall(DSTruncate(svd->ds,k+l,PETSC_FALSE));
1497:       }

1499:       /* compute converged singular vectors and restart vectors */
1500:       PetscCall(DSGetMat(svd->ds,DS_MAT_X,&X));
1501:       PetscCall(BVMultInPlace(V,X,svd->nconv,k+l));
1502:       PetscCall(DSRestoreMat(svd->ds,DS_MAT_X,&X));
1503:       PetscCall(DSGetMat(svd->ds,DS_MAT_U,&U));
1504:       PetscCall(BVMultInPlace(U1,U,svd->nconv,k+l+1));
1505:       PetscCall(DSRestoreMat(svd->ds,DS_MAT_U,&U));
1506:       PetscCall(DSGetMat(svd->ds,DS_MAT_V,&Vmat));
1507:       PetscCall(BVMultInPlace(U2,Vmat,svd->nconv,k+l));
1508:       PetscCall(DSRestoreMat(svd->ds,DS_MAT_V,&Vmat));

1510:       /* copy the last vector to be the next initial vector */
1511:       if (svd->reason == SVD_CONVERGED_ITERATING && !breakdown) PetscCall(BVCopyColumn(V,nv,k+l));
1512:     }

1514:     svd->nconv = k;
1515:     PetscCall(SVDLanczosBackTransform(svd,nv,svd->sigma,sigma,NULL));
1516:     PetscCall(SVDMonitor(svd,svd->its,svd->nconv,sigma,svd->errest,nv));
1517:   }

1519:   PetscCall(PetscFree2(w,sigma));
1520:   PetscFunctionReturn(PETSC_SUCCESS);
1521: }

1523: static PetscErrorCode SVDSolve_TRLanczos_GSVD(SVD svd)
1524: {
1525:   SVD_TRLANCZOS  *lanczos = (SVD_TRLANCZOS*)svd->data;
1526:   PetscInt       k,m,p;
1527:   PetscBool      convchg=PETSC_FALSE;
1528:   BV             U1,U2,UU;
1529:   BVType         type;
1530:   Mat            U,V;
1531:   SlepcSC        sc;

1533:   PetscFunctionBegin;
1534:   PetscCall(PetscCitationsRegister(citationg,&citedg));

1536:   if (svd->swapped) {
1537:     PetscCall(DSGetSlepcSC(svd->ds,&sc));
1538:     if (svd->which==SVD_LARGEST) sc->comparison = SlepcCompareSmallestReal;
1539:     else                         sc->comparison = SlepcCompareLargestReal;
1540:   }
1541:   if (svd->converged==SVDConvergedNorm) {  /* override temporarily since computed residual is already relative to the norms */
1542:     svd->converged = SVDConvergedAbsolute;
1543:     convchg = PETSC_TRUE;
1544:   }
1545:   PetscCall(MatGetLocalSize(svd->A,&m,NULL));
1546:   PetscCall(MatGetLocalSize(svd->B,&p,NULL));

1548:   /* Create BV for U1 */
1549:   PetscCall(BVCreate(PetscObjectComm((PetscObject)svd),&U1));
1550:   PetscCall(BVGetType(svd->U,&type));
1551:   PetscCall(BVSetType(U1,type));
1552:   PetscCall(BVGetSizes(svd->U,NULL,NULL,&k));
1553:   PetscCall(BVSetSizes(U1,m,PETSC_DECIDE,k));

1555:   /* Create BV for U2 */
1556:   PetscCall(BVCreate(PetscObjectComm((PetscObject)svd),&U2));
1557:   PetscCall(BVSetType(U2,type));
1558:   PetscCall(BVSetSizes(U2,p,PETSC_DECIDE,k));

1560:   /* Copy initial vectors from svd->U to U1 and U2 */
1561:   if (svd->ninil) {
1562:     Vec u, uh, nest, aux[2];
1563:     PetscCall(BVGetColumn(U1,0,&u));
1564:     PetscCall(BVGetColumn(U2,0,&uh));
1565:     aux[0] = u;
1566:     aux[1] = uh;
1567:     PetscCall(VecCreateNest(PetscObjectComm((PetscObject)svd),2,NULL,aux,&nest));
1568:     PetscCall(BVCopyVec(svd->U,0,nest));
1569:     PetscCall(BVRestoreColumn(U1,0,&u));
1570:     PetscCall(BVRestoreColumn(U2,0,&uh));
1571:     PetscCall(VecDestroy(&nest));
1572:   }

1574:   switch (lanczos->bidiag) {
1575:     case SVD_TRLANCZOS_GBIDIAG_SINGLE:
1576:       PetscCall(SVDSolve_TRLanczosGSingle(svd,U1,svd->U));
1577:       break;
1578:     case SVD_TRLANCZOS_GBIDIAG_UPPER:
1579:       PetscCall(SVDSolve_TRLanczosGUpper(svd,U1,U2,svd->U));
1580:       break;
1581:     case SVD_TRLANCZOS_GBIDIAG_LOWER:
1582:       PetscCall(SVDSolve_TRLanczosGLower(svd,U1,U2,svd->U));
1583:       break;
1584:   }

1586:   /* Compute converged right singular vectors */
1587:   PetscCall(BVSetActiveColumns(svd->U,0,svd->nconv));
1588:   PetscCall(BVSetActiveColumns(svd->V,0,svd->nconv));
1589:   PetscCall(BVGetMat(svd->U,&U));
1590:   PetscCall(BVGetMat(svd->V,&V));
1591:   PetscCall(KSPMatSolve(lanczos->ksp,U,V));
1592:   PetscCall(BVRestoreMat(svd->U,&U));
1593:   PetscCall(BVRestoreMat(svd->V,&V));

1595:   /* Finish computing left singular vectors and move them to its place */
1596:   if (svd->swapped) SWAP(U1,U2,UU);
1597:   switch (lanczos->bidiag) {
1598:     case SVD_TRLANCZOS_GBIDIAG_SINGLE:
1599:       PetscCall(SVDLeftSingularVectors_Single(svd,U1,U2));
1600:       break;
1601:     case SVD_TRLANCZOS_GBIDIAG_UPPER:
1602:     case SVD_TRLANCZOS_GBIDIAG_LOWER:
1603:       PetscCall(SVDLeftSingularVectors(svd,U1,U2));
1604:       break;
1605:   }

1607:   /* undo scaling and compute the reciprocals of sigma if matrices were swapped */
1608:   PetscCall(SVDLanczosBackTransform(svd,svd->nconv,svd->sigma,NULL,svd->V));

1610:   PetscCall(BVDestroy(&U1));
1611:   PetscCall(BVDestroy(&U2));
1612:   PetscCall(DSTruncate(svd->ds,svd->nconv,PETSC_TRUE));
1613:   if (convchg) svd->converged = SVDConvergedNorm;
1614:   PetscFunctionReturn(PETSC_SUCCESS);
1615: }

1617: static PetscErrorCode SVDSetFromOptions_TRLanczos(SVD svd,PetscOptionItems *PetscOptionsObject)
1618: {
1619:   SVD_TRLANCZOS       *lanczos = (SVD_TRLANCZOS*)svd->data;
1620:   PetscBool           flg,val,lock;
1621:   PetscReal           keep,scale;
1622:   SVDTRLanczosGBidiag bidiag;

1624:   PetscFunctionBegin;
1625:   PetscOptionsHeadBegin(PetscOptionsObject,"SVD TRLanczos Options");

1627:     PetscCall(PetscOptionsBool("-svd_trlanczos_oneside","Use one-side reorthogonalization","SVDTRLanczosSetOneSide",lanczos->oneside,&val,&flg));
1628:     if (flg) PetscCall(SVDTRLanczosSetOneSide(svd,val));

1630:     PetscCall(PetscOptionsReal("-svd_trlanczos_restart","Proportion of vectors kept after restart","SVDTRLanczosSetRestart",0.5,&keep,&flg));
1631:     if (flg) PetscCall(SVDTRLanczosSetRestart(svd,keep));

1633:     PetscCall(PetscOptionsBool("-svd_trlanczos_locking","Choose between locking and non-locking variants","SVDTRLanczosSetLocking",PETSC_TRUE,&lock,&flg));
1634:     if (flg) PetscCall(SVDTRLanczosSetLocking(svd,lock));

1636:     PetscCall(PetscOptionsEnum("-svd_trlanczos_gbidiag","Bidiagonalization choice for Generalized Problem","SVDTRLanczosSetGBidiag",SVDTRLanczosGBidiags,(PetscEnum)lanczos->bidiag,(PetscEnum*)&bidiag,&flg));
1637:     if (flg) PetscCall(SVDTRLanczosSetGBidiag(svd,bidiag));

1639:     PetscCall(PetscOptionsBool("-svd_trlanczos_explicitmatrix","Build explicit matrix for KSP solver","SVDTRLanczosSetExplicitMatrix",lanczos->explicitmatrix,&val,&flg));
1640:     if (flg) PetscCall(SVDTRLanczosSetExplicitMatrix(svd,val));

1642:     PetscCall(SVDTRLanczosGetScale(svd,&scale));
1643:     PetscCall(PetscOptionsReal("-svd_trlanczos_scale","Scale parameter for matrix B","SVDTRLanczosSetScale",scale,&scale,&flg));
1644:     if (flg) PetscCall(SVDTRLanczosSetScale(svd,scale));

1646:   PetscOptionsHeadEnd();

1648:   if (svd->OPb) {
1649:     if (!lanczos->ksp) PetscCall(SVDTRLanczosGetKSP(svd,&lanczos->ksp));
1650:     PetscCall(KSPSetFromOptions(lanczos->ksp));
1651:   }
1652:   PetscFunctionReturn(PETSC_SUCCESS);
1653: }

1655: static PetscErrorCode SVDTRLanczosSetOneSide_TRLanczos(SVD svd,PetscBool oneside)
1656: {
1657:   SVD_TRLANCZOS *lanczos = (SVD_TRLANCZOS*)svd->data;

1659:   PetscFunctionBegin;
1660:   if (lanczos->oneside != oneside) {
1661:     lanczos->oneside = oneside;
1662:     svd->state = SVD_STATE_INITIAL;
1663:   }
1664:   PetscFunctionReturn(PETSC_SUCCESS);
1665: }

1667: /*@
1668:    SVDTRLanczosSetOneSide - Indicate if the variant of the Lanczos method
1669:    to be used is one-sided or two-sided.

1671:    Logically Collective

1673:    Input Parameters:
1674: +  svd     - singular value solver
1675: -  oneside - boolean flag indicating if the method is one-sided or not

1677:    Options Database Key:
1678: .  -svd_trlanczos_oneside <boolean> - Indicates the boolean flag

1680:    Notes:
1681:    By default, a two-sided variant is selected, which is sometimes slightly
1682:    more robust. However, the one-sided variant is faster because it avoids
1683:    the orthogonalization associated to left singular vectors.

1685:    One-sided orthogonalization is also available for the GSVD, in which case
1686:    two orthogonalizations out of three are avoided.

1688:    Level: advanced

1690: .seealso: SVDLanczosSetOneSide()
1691: @*/
1692: PetscErrorCode SVDTRLanczosSetOneSide(SVD svd,PetscBool oneside)
1693: {
1694:   PetscFunctionBegin;
1697:   PetscTryMethod(svd,"SVDTRLanczosSetOneSide_C",(SVD,PetscBool),(svd,oneside));
1698:   PetscFunctionReturn(PETSC_SUCCESS);
1699: }

1701: static PetscErrorCode SVDTRLanczosGetOneSide_TRLanczos(SVD svd,PetscBool *oneside)
1702: {
1703:   SVD_TRLANCZOS *lanczos = (SVD_TRLANCZOS*)svd->data;

1705:   PetscFunctionBegin;
1706:   *oneside = lanczos->oneside;
1707:   PetscFunctionReturn(PETSC_SUCCESS);
1708: }

1710: /*@
1711:    SVDTRLanczosGetOneSide - Gets if the variant of the Lanczos method
1712:    to be used is one-sided or two-sided.

1714:    Not Collective

1716:    Input Parameters:
1717: .  svd     - singular value solver

1719:    Output Parameters:
1720: .  oneside - boolean flag indicating if the method is one-sided or not

1722:    Level: advanced

1724: .seealso: SVDTRLanczosSetOneSide()
1725: @*/
1726: PetscErrorCode SVDTRLanczosGetOneSide(SVD svd,PetscBool *oneside)
1727: {
1728:   PetscFunctionBegin;
1730:   PetscAssertPointer(oneside,2);
1731:   PetscUseMethod(svd,"SVDTRLanczosGetOneSide_C",(SVD,PetscBool*),(svd,oneside));
1732:   PetscFunctionReturn(PETSC_SUCCESS);
1733: }

1735: static PetscErrorCode SVDTRLanczosSetGBidiag_TRLanczos(SVD svd,SVDTRLanczosGBidiag bidiag)
1736: {
1737:   SVD_TRLANCZOS *lanczos = (SVD_TRLANCZOS*)svd->data;

1739:   PetscFunctionBegin;
1740:   switch (bidiag) {
1741:     case SVD_TRLANCZOS_GBIDIAG_SINGLE:
1742:     case SVD_TRLANCZOS_GBIDIAG_UPPER:
1743:     case SVD_TRLANCZOS_GBIDIAG_LOWER:
1744:       if (lanczos->bidiag != bidiag) {
1745:         lanczos->bidiag = bidiag;
1746:         svd->state = SVD_STATE_INITIAL;
1747:       }
1748:       break;
1749:     default:
1750:       SETERRQ(PetscObjectComm((PetscObject)svd),PETSC_ERR_ARG_OUTOFRANGE,"Invalid bidiagonalization choice");
1751:   }
1752:   PetscFunctionReturn(PETSC_SUCCESS);
1753: }

1755: /*@
1756:    SVDTRLanczosSetGBidiag - Sets the bidiagonalization choice to use in
1757:    the GSVD TRLanczos solver.

1759:    Logically Collective

1761:    Input Parameters:
1762: +  svd - the singular value solver
1763: -  bidiag - the bidiagonalization choice

1765:    Options Database Key:
1766: .  -svd_trlanczos_gbidiag - Sets the bidiagonalization choice (either 's' or 'juu'
1767:    or 'jlu')

1769:    Level: advanced

1771: .seealso: SVDTRLanczosGetGBidiag(), SVDTRLanczosGBidiag
1772: @*/
1773: PetscErrorCode SVDTRLanczosSetGBidiag(SVD svd,SVDTRLanczosGBidiag bidiag)
1774: {
1775:   PetscFunctionBegin;
1778:   PetscTryMethod(svd,"SVDTRLanczosSetGBidiag_C",(SVD,SVDTRLanczosGBidiag),(svd,bidiag));
1779:   PetscFunctionReturn(PETSC_SUCCESS);
1780: }

1782: static PetscErrorCode SVDTRLanczosGetGBidiag_TRLanczos(SVD svd,SVDTRLanczosGBidiag *bidiag)
1783: {
1784:   SVD_TRLANCZOS *lanczos = (SVD_TRLANCZOS*)svd->data;

1786:   PetscFunctionBegin;
1787:   *bidiag = lanczos->bidiag;
1788:   PetscFunctionReturn(PETSC_SUCCESS);
1789: }

1791: /*@
1792:    SVDTRLanczosGetGBidiag - Gets the bidiagonalization choice used in the GSVD
1793:    TRLanczos solver.

1795:    Not Collective

1797:    Input Parameter:
1798: .  svd - the singular value solver

1800:    Output Parameter:
1801: .  bidiag - the bidiagonalization choice

1803:    Level: advanced

1805: .seealso: SVDTRLanczosSetGBidiag(), SVDTRLanczosGBidiag
1806: @*/
1807: PetscErrorCode SVDTRLanczosGetGBidiag(SVD svd,SVDTRLanczosGBidiag *bidiag)
1808: {
1809:   PetscFunctionBegin;
1811:   PetscAssertPointer(bidiag,2);
1812:   PetscUseMethod(svd,"SVDTRLanczosGetGBidiag_C",(SVD,SVDTRLanczosGBidiag*),(svd,bidiag));
1813:   PetscFunctionReturn(PETSC_SUCCESS);
1814: }

1816: static PetscErrorCode SVDTRLanczosSetKSP_TRLanczos(SVD svd,KSP ksp)
1817: {
1818:   SVD_TRLANCZOS  *ctx = (SVD_TRLANCZOS*)svd->data;

1820:   PetscFunctionBegin;
1821:   PetscCall(PetscObjectReference((PetscObject)ksp));
1822:   PetscCall(KSPDestroy(&ctx->ksp));
1823:   ctx->ksp   = ksp;
1824:   svd->state = SVD_STATE_INITIAL;
1825:   PetscFunctionReturn(PETSC_SUCCESS);
1826: }

1828: /*@
1829:    SVDTRLanczosSetKSP - Associate a linear solver object (KSP) to the SVD solver.

1831:    Collective

1833:    Input Parameters:
1834: +  svd - SVD solver
1835: -  ksp - the linear solver object

1837:    Note:
1838:    Only used for the GSVD problem.

1840:    Level: advanced

1842: .seealso: SVDTRLanczosGetKSP()
1843: @*/
1844: PetscErrorCode SVDTRLanczosSetKSP(SVD svd,KSP ksp)
1845: {
1846:   PetscFunctionBegin;
1849:   PetscCheckSameComm(svd,1,ksp,2);
1850:   PetscTryMethod(svd,"SVDTRLanczosSetKSP_C",(SVD,KSP),(svd,ksp));
1851:   PetscFunctionReturn(PETSC_SUCCESS);
1852: }

1854: static PetscErrorCode SVDTRLanczosGetKSP_TRLanczos(SVD svd,KSP *ksp)
1855: {
1856:   SVD_TRLANCZOS  *ctx = (SVD_TRLANCZOS*)svd->data;
1857:   PC             pc;

1859:   PetscFunctionBegin;
1860:   if (!ctx->ksp) {
1861:     /* Create linear solver */
1862:     PetscCall(KSPCreate(PetscObjectComm((PetscObject)svd),&ctx->ksp));
1863:     PetscCall(PetscObjectIncrementTabLevel((PetscObject)ctx->ksp,(PetscObject)svd,1));
1864:     PetscCall(KSPSetOptionsPrefix(ctx->ksp,((PetscObject)svd)->prefix));
1865:     PetscCall(KSPAppendOptionsPrefix(ctx->ksp,"svd_trlanczos_"));
1866:     PetscCall(PetscObjectSetOptions((PetscObject)ctx->ksp,((PetscObject)svd)->options));
1867:     PetscCall(KSPSetType(ctx->ksp,KSPLSQR));
1868:     PetscCall(KSPGetPC(ctx->ksp,&pc));
1869:     PetscCall(PCSetType(pc,PCNONE));
1870:     PetscCall(KSPSetErrorIfNotConverged(ctx->ksp,PETSC_TRUE));
1871:     PetscCall(KSPSetTolerances(ctx->ksp,SlepcDefaultTol(svd->tol)/10.0,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT));
1872:   }
1873:   *ksp = ctx->ksp;
1874:   PetscFunctionReturn(PETSC_SUCCESS);
1875: }

1877: /*@
1878:    SVDTRLanczosGetKSP - Retrieve the linear solver object (KSP) associated with
1879:    the SVD solver.

1881:    Collective

1883:    Input Parameter:
1884: .  svd - SVD solver

1886:    Output Parameter:
1887: .  ksp - the linear solver object

1889:    Level: advanced

1891: .seealso: SVDTRLanczosSetKSP()
1892: @*/
1893: PetscErrorCode SVDTRLanczosGetKSP(SVD svd,KSP *ksp)
1894: {
1895:   PetscFunctionBegin;
1897:   PetscAssertPointer(ksp,2);
1898:   PetscUseMethod(svd,"SVDTRLanczosGetKSP_C",(SVD,KSP*),(svd,ksp));
1899:   PetscFunctionReturn(PETSC_SUCCESS);
1900: }

1902: static PetscErrorCode SVDTRLanczosSetRestart_TRLanczos(SVD svd,PetscReal keep)
1903: {
1904:   SVD_TRLANCZOS *ctx = (SVD_TRLANCZOS*)svd->data;

1906:   PetscFunctionBegin;
1907:   if (keep==(PetscReal)PETSC_DEFAULT) ctx->keep = 0.5;
1908:   else {
1909:     PetscCheck(keep>=0.1 && keep<=0.9,PetscObjectComm((PetscObject)svd),PETSC_ERR_ARG_OUTOFRANGE,"The keep argument %g must be in the range [0.1,0.9]",(double)keep);
1910:     ctx->keep = keep;
1911:   }
1912:   PetscFunctionReturn(PETSC_SUCCESS);
1913: }

1915: /*@
1916:    SVDTRLanczosSetRestart - Sets the restart parameter for the thick-restart
1917:    Lanczos method, in particular the proportion of basis vectors that must be
1918:    kept after restart.

1920:    Logically Collective

1922:    Input Parameters:
1923: +  svd  - the singular value solver
1924: -  keep - the number of vectors to be kept at restart

1926:    Options Database Key:
1927: .  -svd_trlanczos_restart - Sets the restart parameter

1929:    Notes:
1930:    Allowed values are in the range [0.1,0.9]. The default is 0.5.

1932:    Level: advanced

1934: .seealso: SVDTRLanczosGetRestart()
1935: @*/
1936: PetscErrorCode SVDTRLanczosSetRestart(SVD svd,PetscReal keep)
1937: {
1938:   PetscFunctionBegin;
1941:   PetscTryMethod(svd,"SVDTRLanczosSetRestart_C",(SVD,PetscReal),(svd,keep));
1942:   PetscFunctionReturn(PETSC_SUCCESS);
1943: }

1945: static PetscErrorCode SVDTRLanczosGetRestart_TRLanczos(SVD svd,PetscReal *keep)
1946: {
1947:   SVD_TRLANCZOS *ctx = (SVD_TRLANCZOS*)svd->data;

1949:   PetscFunctionBegin;
1950:   *keep = ctx->keep;
1951:   PetscFunctionReturn(PETSC_SUCCESS);
1952: }

1954: /*@
1955:    SVDTRLanczosGetRestart - Gets the restart parameter used in the thick-restart
1956:    Lanczos method.

1958:    Not Collective

1960:    Input Parameter:
1961: .  svd - the singular value solver

1963:    Output Parameter:
1964: .  keep - the restart parameter

1966:    Level: advanced

1968: .seealso: SVDTRLanczosSetRestart()
1969: @*/
1970: PetscErrorCode SVDTRLanczosGetRestart(SVD svd,PetscReal *keep)
1971: {
1972:   PetscFunctionBegin;
1974:   PetscAssertPointer(keep,2);
1975:   PetscUseMethod(svd,"SVDTRLanczosGetRestart_C",(SVD,PetscReal*),(svd,keep));
1976:   PetscFunctionReturn(PETSC_SUCCESS);
1977: }

1979: static PetscErrorCode SVDTRLanczosSetLocking_TRLanczos(SVD svd,PetscBool lock)
1980: {
1981:   SVD_TRLANCZOS *ctx = (SVD_TRLANCZOS*)svd->data;

1983:   PetscFunctionBegin;
1984:   ctx->lock = lock;
1985:   PetscFunctionReturn(PETSC_SUCCESS);
1986: }

1988: /*@
1989:    SVDTRLanczosSetLocking - Choose between locking and non-locking variants of
1990:    the thick-restart Lanczos method.

1992:    Logically Collective

1994:    Input Parameters:
1995: +  svd  - the singular value solver
1996: -  lock - true if the locking variant must be selected

1998:    Options Database Key:
1999: .  -svd_trlanczos_locking - Sets the locking flag

2001:    Notes:
2002:    The default is to lock converged singular triplets when the method restarts.
2003:    This behaviour can be changed so that all directions are kept in the
2004:    working subspace even if already converged to working accuracy (the
2005:    non-locking variant).

2007:    Level: advanced

2009: .seealso: SVDTRLanczosGetLocking()
2010: @*/
2011: PetscErrorCode SVDTRLanczosSetLocking(SVD svd,PetscBool lock)
2012: {
2013:   PetscFunctionBegin;
2016:   PetscTryMethod(svd,"SVDTRLanczosSetLocking_C",(SVD,PetscBool),(svd,lock));
2017:   PetscFunctionReturn(PETSC_SUCCESS);
2018: }

2020: static PetscErrorCode SVDTRLanczosGetLocking_TRLanczos(SVD svd,PetscBool *lock)
2021: {
2022:   SVD_TRLANCZOS *ctx = (SVD_TRLANCZOS*)svd->data;

2024:   PetscFunctionBegin;
2025:   *lock = ctx->lock;
2026:   PetscFunctionReturn(PETSC_SUCCESS);
2027: }

2029: /*@
2030:    SVDTRLanczosGetLocking - Gets the locking flag used in the thick-restart
2031:    Lanczos method.

2033:    Not Collective

2035:    Input Parameter:
2036: .  svd - the singular value solver

2038:    Output Parameter:
2039: .  lock - the locking flag

2041:    Level: advanced

2043: .seealso: SVDTRLanczosSetLocking()
2044: @*/
2045: PetscErrorCode SVDTRLanczosGetLocking(SVD svd,PetscBool *lock)
2046: {
2047:   PetscFunctionBegin;
2049:   PetscAssertPointer(lock,2);
2050:   PetscUseMethod(svd,"SVDTRLanczosGetLocking_C",(SVD,PetscBool*),(svd,lock));
2051:   PetscFunctionReturn(PETSC_SUCCESS);
2052: }

2054: static PetscErrorCode SVDTRLanczosSetExplicitMatrix_TRLanczos(SVD svd,PetscBool explicitmat)
2055: {
2056:   SVD_TRLANCZOS *lanczos = (SVD_TRLANCZOS*)svd->data;

2058:   PetscFunctionBegin;
2059:   if (lanczos->explicitmatrix != explicitmat) {
2060:     lanczos->explicitmatrix = explicitmat;
2061:     svd->state = SVD_STATE_INITIAL;
2062:   }
2063:   PetscFunctionReturn(PETSC_SUCCESS);
2064: }

2066: /*@
2067:    SVDTRLanczosSetExplicitMatrix - Indicate if the matrix Z=[A;B] must
2068:    be built explicitly.

2070:    Logically Collective

2072:    Input Parameters:
2073: +  svd         - singular value solver
2074: -  explicitmat - Boolean flag indicating if Z=[A;B] is built explicitly

2076:    Options Database Key:
2077: .  -svd_trlanczos_explicitmatrix <boolean> - Indicates the boolean flag

2079:    Notes:
2080:    This option is relevant for the GSVD case only.
2081:    Z is the coefficient matrix of the KSP solver used internally.

2083:    Level: advanced

2085: .seealso: SVDTRLanczosGetExplicitMatrix()
2086: @*/
2087: PetscErrorCode SVDTRLanczosSetExplicitMatrix(SVD svd,PetscBool explicitmat)
2088: {
2089:   PetscFunctionBegin;
2092:   PetscTryMethod(svd,"SVDTRLanczosSetExplicitMatrix_C",(SVD,PetscBool),(svd,explicitmat));
2093:   PetscFunctionReturn(PETSC_SUCCESS);
2094: }

2096: static PetscErrorCode SVDTRLanczosGetExplicitMatrix_TRLanczos(SVD svd,PetscBool *explicitmat)
2097: {
2098:   SVD_TRLANCZOS *lanczos = (SVD_TRLANCZOS*)svd->data;

2100:   PetscFunctionBegin;
2101:   *explicitmat = lanczos->explicitmatrix;
2102:   PetscFunctionReturn(PETSC_SUCCESS);
2103: }

2105: /*@
2106:    SVDTRLanczosGetExplicitMatrix - Returns the flag indicating if Z=[A;B] is built explicitly.

2108:    Not Collective

2110:    Input Parameter:
2111: .  svd  - singular value solver

2113:    Output Parameter:
2114: .  explicitmat - the mode flag

2116:    Level: advanced

2118: .seealso: SVDTRLanczosSetExplicitMatrix()
2119: @*/
2120: PetscErrorCode SVDTRLanczosGetExplicitMatrix(SVD svd,PetscBool *explicitmat)
2121: {
2122:   PetscFunctionBegin;
2124:   PetscAssertPointer(explicitmat,2);
2125:   PetscUseMethod(svd,"SVDTRLanczosGetExplicitMatrix_C",(SVD,PetscBool*),(svd,explicitmat));
2126:   PetscFunctionReturn(PETSC_SUCCESS);
2127: }

2129: static PetscErrorCode SVDTRLanczosSetScale_TRLanczos(SVD svd,PetscReal scale)
2130: {
2131:   SVD_TRLANCZOS *ctx = (SVD_TRLANCZOS*)svd->data;

2133:   PetscFunctionBegin;
2134:   if (scale<0) {
2135:     ctx->scalef  = 1.0;
2136:     ctx->scaleth = -scale;
2137:   } else {
2138:     ctx->scalef  = scale;
2139:     ctx->scaleth = 0.0;
2140:   }
2141:   PetscFunctionReturn(PETSC_SUCCESS);
2142: }

2144: /*@
2145:    SVDTRLanczosSetScale - Sets the scale parameter for the GSVD.

2147:    Logically Collective

2149:    Input Parameters:
2150: +  svd   - singular value solver
2151: -  scale - scale parameter

2153:    Options Database Key:
2154: .  -svd_trlanczos_scale <real> - scale factor/threshold

2156:    Notes:
2157:    This parameter is relevant for the GSVD case only. If the parameter is
2158:    positive, it indicates the scale factor for B in matrix Z=[A;B]. If
2159:    negative, its absolute value is the threshold for automatic scaling.
2160:    In automatic scaling, whenever the largest approximate generalized singular
2161:    value (or the inverse of the smallest value, if SVD_SMALLEST is used)
2162:    exceeds the threshold, the computation is restarted with matrix B
2163:    scaled by that value.

2165:    Level: advanced

2167: .seealso: SVDTRLanczosGetScale()
2168: @*/
2169: PetscErrorCode SVDTRLanczosSetScale(SVD svd,PetscReal scale)
2170: {
2171:   PetscFunctionBegin;
2174:   PetscTryMethod(svd,"SVDTRLanczosSetScale_C",(SVD,PetscReal),(svd,scale));
2175:   PetscFunctionReturn(PETSC_SUCCESS);
2176: }

2178: static PetscErrorCode SVDTRLanczosGetScale_TRLanczos(SVD svd,PetscReal *scale)
2179: {
2180:   SVD_TRLANCZOS *ctx = (SVD_TRLANCZOS*)svd->data;

2182:   PetscFunctionBegin;
2183:   if (ctx->scaleth==0) *scale = ctx->scalef;
2184:   else                 *scale = -ctx->scaleth;
2185:   PetscFunctionReturn(PETSC_SUCCESS);
2186: }

2188: /*@
2189:    SVDTRLanczosGetScale - Gets the scale parameter for the GSVD.

2191:    Not Collective

2193:    Input Parameter:
2194: .  svd - the singular value solver

2196:    Output Parameter:
2197: .  scale - the scale parameter

2199:    Notes:
2200:    This parameter is relevant for the GSVD case only. If the parameter is
2201:    positive, it indicates the scale factor for B in matrix Z=[A;B]. If
2202:    negative, its absolute value is the threshold for automatic scaling.

2204:    Level: advanced

2206: .seealso: SVDTRLanczosSetScale()
2207: @*/
2208: PetscErrorCode SVDTRLanczosGetScale(SVD svd,PetscReal *scale)
2209: {
2210:   PetscFunctionBegin;
2212:   PetscAssertPointer(scale,2);
2213:   PetscUseMethod(svd,"SVDTRLanczosGetScale_C",(SVD,PetscReal*),(svd,scale));
2214:   PetscFunctionReturn(PETSC_SUCCESS);
2215: }

2217: static PetscErrorCode SVDReset_TRLanczos(SVD svd)
2218: {
2219:   SVD_TRLANCZOS  *lanczos = (SVD_TRLANCZOS*)svd->data;

2221:   PetscFunctionBegin;
2222:   if (svd->isgeneralized || (!svd->problem_type && svd->OPb)) {
2223:     PetscCall(KSPReset(lanczos->ksp));
2224:     PetscCall(MatDestroy(&lanczos->Z));
2225:   }
2226:   PetscFunctionReturn(PETSC_SUCCESS);
2227: }

2229: static PetscErrorCode SVDDestroy_TRLanczos(SVD svd)
2230: {
2231:   SVD_TRLANCZOS  *lanczos = (SVD_TRLANCZOS*)svd->data;

2233:   PetscFunctionBegin;
2234:   if (svd->isgeneralized || (!svd->problem_type && svd->OPb)) PetscCall(KSPDestroy(&lanczos->ksp));
2235:   PetscCall(PetscFree(svd->data));
2236:   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosSetOneSide_C",NULL));
2237:   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosGetOneSide_C",NULL));
2238:   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosSetGBidiag_C",NULL));
2239:   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosGetGBidiag_C",NULL));
2240:   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosSetKSP_C",NULL));
2241:   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosGetKSP_C",NULL));
2242:   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosSetRestart_C",NULL));
2243:   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosGetRestart_C",NULL));
2244:   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosSetLocking_C",NULL));
2245:   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosGetLocking_C",NULL));
2246:   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosSetExplicitMatrix_C",NULL));
2247:   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosGetExplicitMatrix_C",NULL));
2248:   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosSetScale_C",NULL));
2249:   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosGetScale_C",NULL));
2250:   PetscFunctionReturn(PETSC_SUCCESS);
2251: }

2253: static PetscErrorCode SVDView_TRLanczos(SVD svd,PetscViewer viewer)
2254: {
2255:   SVD_TRLANCZOS  *lanczos = (SVD_TRLANCZOS*)svd->data;
2256:   PetscBool      isascii;

2258:   PetscFunctionBegin;
2259:   PetscCall(PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii));
2260:   if (isascii) {
2261:     PetscCall(PetscViewerASCIIPrintf(viewer,"  %d%% of basis vectors kept after restart\n",(int)(100*lanczos->keep)));
2262:     PetscCall(PetscViewerASCIIPrintf(viewer,"  using the %slocking variant\n",lanczos->lock?"":"non-"));
2263:     if (svd->isgeneralized) {
2264:       const char *bidiag="";

2266:       switch (lanczos->bidiag) {
2267:         case SVD_TRLANCZOS_GBIDIAG_SINGLE: bidiag = "single"; break;
2268:         case SVD_TRLANCZOS_GBIDIAG_UPPER:  bidiag = "joint upper-upper"; break;
2269:         case SVD_TRLANCZOS_GBIDIAG_LOWER:  bidiag = "joint lower-upper"; break;
2270:       }
2271:       PetscCall(PetscViewerASCIIPrintf(viewer,"  bidiagonalization choice: %s\n",bidiag));
2272:       PetscCall(PetscViewerASCIIPrintf(viewer,"  %s matrix\n",lanczos->explicitmatrix?"explicit":"implicit"));
2273:       if (lanczos->scaleth==0) PetscCall(PetscViewerASCIIPrintf(viewer,"  scale factor for matrix B: %g\n",(double)lanczos->scalef));
2274:       else PetscCall(PetscViewerASCIIPrintf(viewer,"  automatic scaling for matrix B with threshold: %g\n",(double)lanczos->scaleth));
2275:       if (!lanczos->ksp) PetscCall(SVDTRLanczosGetKSP(svd,&lanczos->ksp));
2276:       PetscCall(PetscViewerASCIIPushTab(viewer));
2277:       PetscCall(KSPView(lanczos->ksp,viewer));
2278:       PetscCall(PetscViewerASCIIPopTab(viewer));
2279:     } else PetscCall(PetscViewerASCIIPrintf(viewer,"  %s-sided reorthogonalization\n",lanczos->oneside? "one": "two"));
2280:   }
2281:   PetscFunctionReturn(PETSC_SUCCESS);
2282: }

2284: static PetscErrorCode SVDSetDSType_TRLanczos(SVD svd)
2285: {
2286:   SVD_TRLANCZOS  *lanczos = (SVD_TRLANCZOS*)svd->data;
2287:   DSType         dstype;

2289:   PetscFunctionBegin;
2290:   dstype = svd->ishyperbolic? DSHSVD: DSSVD;
2291:   if (svd->OPb && (lanczos->bidiag==SVD_TRLANCZOS_GBIDIAG_UPPER || lanczos->bidiag==SVD_TRLANCZOS_GBIDIAG_LOWER)) dstype = DSGSVD;
2292:   PetscCall(DSSetType(svd->ds,dstype));
2293:   PetscFunctionReturn(PETSC_SUCCESS);
2294: }

2296: SLEPC_EXTERN PetscErrorCode SVDCreate_TRLanczos(SVD svd)
2297: {
2298:   SVD_TRLANCZOS  *ctx;

2300:   PetscFunctionBegin;
2301:   PetscCall(PetscNew(&ctx));
2302:   svd->data = (void*)ctx;

2304:   ctx->lock    = PETSC_TRUE;
2305:   ctx->bidiag  = SVD_TRLANCZOS_GBIDIAG_LOWER;
2306:   ctx->scalef  = 1.0;
2307:   ctx->scaleth = 0.0;

2309:   svd->ops->setup          = SVDSetUp_TRLanczos;
2310:   svd->ops->solve          = SVDSolve_TRLanczos;
2311:   svd->ops->solveg         = SVDSolve_TRLanczos_GSVD;
2312:   svd->ops->solveh         = SVDSolve_TRLanczos_HSVD;
2313:   svd->ops->destroy        = SVDDestroy_TRLanczos;
2314:   svd->ops->reset          = SVDReset_TRLanczos;
2315:   svd->ops->setfromoptions = SVDSetFromOptions_TRLanczos;
2316:   svd->ops->view           = SVDView_TRLanczos;
2317:   svd->ops->setdstype      = SVDSetDSType_TRLanczos;
2318:   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosSetOneSide_C",SVDTRLanczosSetOneSide_TRLanczos));
2319:   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosGetOneSide_C",SVDTRLanczosGetOneSide_TRLanczos));
2320:   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosSetGBidiag_C",SVDTRLanczosSetGBidiag_TRLanczos));
2321:   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosGetGBidiag_C",SVDTRLanczosGetGBidiag_TRLanczos));
2322:   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosSetKSP_C",SVDTRLanczosSetKSP_TRLanczos));
2323:   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosGetKSP_C",SVDTRLanczosGetKSP_TRLanczos));
2324:   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosSetRestart_C",SVDTRLanczosSetRestart_TRLanczos));
2325:   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosGetRestart_C",SVDTRLanczosGetRestart_TRLanczos));
2326:   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosSetLocking_C",SVDTRLanczosSetLocking_TRLanczos));
2327:   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosGetLocking_C",SVDTRLanczosGetLocking_TRLanczos));
2328:   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosSetExplicitMatrix_C",SVDTRLanczosSetExplicitMatrix_TRLanczos));
2329:   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosGetExplicitMatrix_C",SVDTRLanczosGetExplicitMatrix_TRLanczos));
2330:   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosSetScale_C",SVDTRLanczosSetScale_TRLanczos));
2331:   PetscCall(PetscObjectComposeFunction((PetscObject)svd,"SVDTRLanczosGetScale_C",SVDTRLanczosGetScale_TRLanczos));
2332:   PetscFunctionReturn(PETSC_SUCCESS);
2333: }