Actual source code: trlanczos.c
slepc-3.21.1 2024-04-26
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:   "   journal = \"J. Comput. Appl. Math.\",\n"
     49:   "   volume = \"440\",\n"
     50:   "   pages = \"115506\",\n"
     51:   "   year = \"2024\"\n"
     52:   "}\n";

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

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

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

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

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

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

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

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

    137: static PetscErrorCode MatDestroy_Z(Mat Z)
    138: {
    139:   MatZData       *zdata;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    417:     alpha[i-1] = a;
    418:     beta[i-1] = b;
    419:   }

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    555: 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)
    556: {
    557:   PetscInt       i;
    558:   Vec            u,v,ou=svd->workl[0];
    559:   PetscBool      lindep=PETSC_FALSE;
    560:   PetscReal      norm;

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

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

    590:   if (breakdown) *breakdown = lindep;
    591:   PetscFunctionReturn(PETSC_SUCCESS);
    592: }

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    801:     PetscCall(BVGetColumn(V,i,&v));
    802:     PetscCall(BVGetColumn(U,i,&u));

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    911:     } else {

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

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

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

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

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

    951:   PetscCall(PetscFree2(w,sigma));
    952:   PetscFunctionReturn(PETSC_SUCCESS);
    953: }

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

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

    996: 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)
    997: {
    998:   SVD_TRLANCZOS     *lanczos = (SVD_TRLANCZOS*)svd->data;
    999:   PetscInt          i,j,m,p;
    1000:   const PetscScalar *carr;
    1001:   PetscScalar       *arr,*u2arr;
    1002:   Vec               u,v,ut=svd->workl[0],x=svd->workr[0],v1,u1,u2;
    1003:   PetscBool         lindep=PETSC_FALSE,lindep1=PETSC_FALSE,lindep2=PETSC_FALSE;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    1180:     } else {

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

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

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

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

    1222:   PetscCall(PetscFree2(w,sigma));
    1223:   PetscFunctionReturn(PETSC_SUCCESS);
    1224: }

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

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

    1258: 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)
    1259: {
    1260:   SVD_TRLANCZOS     *lanczos = (SVD_TRLANCZOS*)svd->data;
    1261:   PetscInt          i,j,m,p;
    1262:   const PetscScalar *carr;
    1263:   PetscScalar       *arr,*u2arr;
    1264:   Vec               u,v,ut=svd->workl[0],x=svd->workr[0],v1,u1,u2;
    1265:   PetscBool         lindep=PETSC_FALSE;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    1478:     } else {

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

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

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

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

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

    1521:   PetscCall(PetscFree2(w,sigma));
    1522:   PetscFunctionReturn(PETSC_SUCCESS);
    1523: }

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

    1536:   PetscFunctionBegin;
    1537:   PetscCall(PetscCitationsRegister(citationg,&citedg));

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

    1551:   /* Create BV for U1 */
    1552:   PetscCall(BVCreate(PetscObjectComm((PetscObject)svd),&U1));
    1553:   PetscCall(BVGetType(svd->U,&type));
    1554:   PetscCall(BVSetType(U1,type));
    1555:   PetscCall(BVGetSizes(svd->U,NULL,NULL,&k));
    1556:   PetscCall(BVSetSizes(U1,m,PETSC_DECIDE,k));
    1557:   PetscCall(BVGetVecType(svd->U,&vtype));
    1558:   PetscCall(BVSetVecType(U1,vtype));

    1560:   /* Create BV for U2 */
    1561:   PetscCall(BVCreate(PetscObjectComm((PetscObject)svd),&U2));
    1562:   PetscCall(BVSetType(U2,type));
    1563:   PetscCall(BVSetSizes(U2,p,PETSC_DECIDE,k));
    1564:   PetscCall(BVSetVecType(U2,vtype));

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

    1580:   switch (lanczos->bidiag) {
    1581:     case SVD_TRLANCZOS_GBIDIAG_SINGLE:
    1582:       PetscCall(SVDSolve_TRLanczosGSingle(svd,U1,svd->U));
    1583:       break;
    1584:     case SVD_TRLANCZOS_GBIDIAG_UPPER:
    1585:       PetscCall(SVDSolve_TRLanczosGUpper(svd,U1,U2,svd->U));
    1586:       break;
    1587:     case SVD_TRLANCZOS_GBIDIAG_LOWER:
    1588:       PetscCall(SVDSolve_TRLanczosGLower(svd,U1,U2,svd->U));
    1589:       break;
    1590:   }

    1592:   /* Compute converged right singular vectors */
    1593:   PetscCall(BVSetActiveColumns(svd->U,0,svd->nconv));
    1594:   PetscCall(BVSetActiveColumns(svd->V,0,svd->nconv));
    1595:   PetscCall(BVGetMat(svd->U,&U));
    1596:   PetscCall(BVGetMat(svd->V,&V));
    1597:   PetscCall(KSPMatSolve(lanczos->ksp,U,V));
    1598:   PetscCall(BVRestoreMat(svd->U,&U));
    1599:   PetscCall(BVRestoreMat(svd->V,&V));

    1601:   /* Finish computing left singular vectors and move them to its place */
    1602:   if (svd->swapped) SWAP(U1,U2,UU);
    1603:   switch (lanczos->bidiag) {
    1604:     case SVD_TRLANCZOS_GBIDIAG_SINGLE:
    1605:       PetscCall(SVDLeftSingularVectors_Single(svd,U1,U2));
    1606:       break;
    1607:     case SVD_TRLANCZOS_GBIDIAG_UPPER:
    1608:     case SVD_TRLANCZOS_GBIDIAG_LOWER:
    1609:       PetscCall(SVDLeftSingularVectors(svd,U1,U2));
    1610:       break;
    1611:   }

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

    1616:   PetscCall(BVDestroy(&U1));
    1617:   PetscCall(BVDestroy(&U2));
    1618:   PetscCall(DSTruncate(svd->ds,svd->nconv,PETSC_TRUE));
    1619:   if (convchg) svd->converged = SVDConvergedNorm;
    1620:   PetscFunctionReturn(PETSC_SUCCESS);
    1621: }

    1623: static PetscErrorCode SVDSetFromOptions_TRLanczos(SVD svd,PetscOptionItems *PetscOptionsObject)
    1624: {
    1625:   SVD_TRLANCZOS       *lanczos = (SVD_TRLANCZOS*)svd->data;
    1626:   PetscBool           flg,val,lock;
    1627:   PetscReal           keep,scale;
    1628:   SVDTRLanczosGBidiag bidiag;

    1630:   PetscFunctionBegin;
    1631:   PetscOptionsHeadBegin(PetscOptionsObject,"SVD TRLanczos Options");

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

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

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

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

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

    1648:     PetscCall(SVDTRLanczosGetScale(svd,&scale));
    1649:     PetscCall(PetscOptionsReal("-svd_trlanczos_scale","Scale parameter for matrix B","SVDTRLanczosSetScale",scale,&scale,&flg));
    1650:     if (flg) PetscCall(SVDTRLanczosSetScale(svd,scale));

    1652:   PetscOptionsHeadEnd();

    1654:   if (svd->OPb) {
    1655:     if (!lanczos->ksp) PetscCall(SVDTRLanczosGetKSP(svd,&lanczos->ksp));
    1656:     PetscCall(KSPSetFromOptions(lanczos->ksp));
    1657:   }
    1658:   PetscFunctionReturn(PETSC_SUCCESS);
    1659: }

    1661: static PetscErrorCode SVDTRLanczosSetOneSide_TRLanczos(SVD svd,PetscBool oneside)
    1662: {
    1663:   SVD_TRLANCZOS *lanczos = (SVD_TRLANCZOS*)svd->data;

    1665:   PetscFunctionBegin;
    1666:   if (lanczos->oneside != oneside) {
    1667:     lanczos->oneside = oneside;
    1668:     svd->state = SVD_STATE_INITIAL;
    1669:   }
    1670:   PetscFunctionReturn(PETSC_SUCCESS);
    1671: }

    1673: /*@
    1674:    SVDTRLanczosSetOneSide - Indicate if the variant of the Lanczos method
    1675:    to be used is one-sided or two-sided.

    1677:    Logically Collective

    1679:    Input Parameters:
    1680: +  svd     - singular value solver
    1681: -  oneside - boolean flag indicating if the method is one-sided or not

    1683:    Options Database Key:
    1684: .  -svd_trlanczos_oneside <boolean> - Indicates the boolean flag

    1686:    Notes:
    1687:    By default, a two-sided variant is selected, which is sometimes slightly
    1688:    more robust. However, the one-sided variant is faster because it avoids
    1689:    the orthogonalization associated to left singular vectors.

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

    1694:    Level: advanced

    1696: .seealso: SVDLanczosSetOneSide()
    1697: @*/
    1698: PetscErrorCode SVDTRLanczosSetOneSide(SVD svd,PetscBool oneside)
    1699: {
    1700:   PetscFunctionBegin;
    1703:   PetscTryMethod(svd,"SVDTRLanczosSetOneSide_C",(SVD,PetscBool),(svd,oneside));
    1704:   PetscFunctionReturn(PETSC_SUCCESS);
    1705: }

    1707: static PetscErrorCode SVDTRLanczosGetOneSide_TRLanczos(SVD svd,PetscBool *oneside)
    1708: {
    1709:   SVD_TRLANCZOS *lanczos = (SVD_TRLANCZOS*)svd->data;

    1711:   PetscFunctionBegin;
    1712:   *oneside = lanczos->oneside;
    1713:   PetscFunctionReturn(PETSC_SUCCESS);
    1714: }

    1716: /*@
    1717:    SVDTRLanczosGetOneSide - Gets if the variant of the Lanczos method
    1718:    to be used is one-sided or two-sided.

    1720:    Not Collective

    1722:    Input Parameters:
    1723: .  svd     - singular value solver

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

    1728:    Level: advanced

    1730: .seealso: SVDTRLanczosSetOneSide()
    1731: @*/
    1732: PetscErrorCode SVDTRLanczosGetOneSide(SVD svd,PetscBool *oneside)
    1733: {
    1734:   PetscFunctionBegin;
    1736:   PetscAssertPointer(oneside,2);
    1737:   PetscUseMethod(svd,"SVDTRLanczosGetOneSide_C",(SVD,PetscBool*),(svd,oneside));
    1738:   PetscFunctionReturn(PETSC_SUCCESS);
    1739: }

    1741: static PetscErrorCode SVDTRLanczosSetGBidiag_TRLanczos(SVD svd,SVDTRLanczosGBidiag bidiag)
    1742: {
    1743:   SVD_TRLANCZOS *lanczos = (SVD_TRLANCZOS*)svd->data;

    1745:   PetscFunctionBegin;
    1746:   switch (bidiag) {
    1747:     case SVD_TRLANCZOS_GBIDIAG_SINGLE:
    1748:     case SVD_TRLANCZOS_GBIDIAG_UPPER:
    1749:     case SVD_TRLANCZOS_GBIDIAG_LOWER:
    1750:       if (lanczos->bidiag != bidiag) {
    1751:         lanczos->bidiag = bidiag;
    1752:         svd->state = SVD_STATE_INITIAL;
    1753:       }
    1754:       break;
    1755:     default:
    1756:       SETERRQ(PetscObjectComm((PetscObject)svd),PETSC_ERR_ARG_OUTOFRANGE,"Invalid bidiagonalization choice");
    1757:   }
    1758:   PetscFunctionReturn(PETSC_SUCCESS);
    1759: }

    1761: /*@
    1762:    SVDTRLanczosSetGBidiag - Sets the bidiagonalization choice to use in
    1763:    the GSVD TRLanczos solver.

    1765:    Logically Collective

    1767:    Input Parameters:
    1768: +  svd - the singular value solver
    1769: -  bidiag - the bidiagonalization choice

    1771:    Options Database Key:
    1772: .  -svd_trlanczos_gbidiag - Sets the bidiagonalization choice (either 's' or 'juu'
    1773:    or 'jlu')

    1775:    Level: advanced

    1777: .seealso: SVDTRLanczosGetGBidiag(), SVDTRLanczosGBidiag
    1778: @*/
    1779: PetscErrorCode SVDTRLanczosSetGBidiag(SVD svd,SVDTRLanczosGBidiag bidiag)
    1780: {
    1781:   PetscFunctionBegin;
    1784:   PetscTryMethod(svd,"SVDTRLanczosSetGBidiag_C",(SVD,SVDTRLanczosGBidiag),(svd,bidiag));
    1785:   PetscFunctionReturn(PETSC_SUCCESS);
    1786: }

    1788: static PetscErrorCode SVDTRLanczosGetGBidiag_TRLanczos(SVD svd,SVDTRLanczosGBidiag *bidiag)
    1789: {
    1790:   SVD_TRLANCZOS *lanczos = (SVD_TRLANCZOS*)svd->data;

    1792:   PetscFunctionBegin;
    1793:   *bidiag = lanczos->bidiag;
    1794:   PetscFunctionReturn(PETSC_SUCCESS);
    1795: }

    1797: /*@
    1798:    SVDTRLanczosGetGBidiag - Gets the bidiagonalization choice used in the GSVD
    1799:    TRLanczos solver.

    1801:    Not Collective

    1803:    Input Parameter:
    1804: .  svd - the singular value solver

    1806:    Output Parameter:
    1807: .  bidiag - the bidiagonalization choice

    1809:    Level: advanced

    1811: .seealso: SVDTRLanczosSetGBidiag(), SVDTRLanczosGBidiag
    1812: @*/
    1813: PetscErrorCode SVDTRLanczosGetGBidiag(SVD svd,SVDTRLanczosGBidiag *bidiag)
    1814: {
    1815:   PetscFunctionBegin;
    1817:   PetscAssertPointer(bidiag,2);
    1818:   PetscUseMethod(svd,"SVDTRLanczosGetGBidiag_C",(SVD,SVDTRLanczosGBidiag*),(svd,bidiag));
    1819:   PetscFunctionReturn(PETSC_SUCCESS);
    1820: }

    1822: static PetscErrorCode SVDTRLanczosSetKSP_TRLanczos(SVD svd,KSP ksp)
    1823: {
    1824:   SVD_TRLANCZOS  *ctx = (SVD_TRLANCZOS*)svd->data;

    1826:   PetscFunctionBegin;
    1827:   PetscCall(PetscObjectReference((PetscObject)ksp));
    1828:   PetscCall(KSPDestroy(&ctx->ksp));
    1829:   ctx->ksp   = ksp;
    1830:   svd->state = SVD_STATE_INITIAL;
    1831:   PetscFunctionReturn(PETSC_SUCCESS);
    1832: }

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

    1837:    Collective

    1839:    Input Parameters:
    1840: +  svd - SVD solver
    1841: -  ksp - the linear solver object

    1843:    Note:
    1844:    Only used for the GSVD problem.

    1846:    Level: advanced

    1848: .seealso: SVDTRLanczosGetKSP()
    1849: @*/
    1850: PetscErrorCode SVDTRLanczosSetKSP(SVD svd,KSP ksp)
    1851: {
    1852:   PetscFunctionBegin;
    1855:   PetscCheckSameComm(svd,1,ksp,2);
    1856:   PetscTryMethod(svd,"SVDTRLanczosSetKSP_C",(SVD,KSP),(svd,ksp));
    1857:   PetscFunctionReturn(PETSC_SUCCESS);
    1858: }

    1860: static PetscErrorCode SVDTRLanczosGetKSP_TRLanczos(SVD svd,KSP *ksp)
    1861: {
    1862:   SVD_TRLANCZOS  *ctx = (SVD_TRLANCZOS*)svd->data;
    1863:   PC             pc;

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

    1883: /*@
    1884:    SVDTRLanczosGetKSP - Retrieve the linear solver object (KSP) associated with
    1885:    the SVD solver.

    1887:    Collective

    1889:    Input Parameter:
    1890: .  svd - SVD solver

    1892:    Output Parameter:
    1893: .  ksp - the linear solver object

    1895:    Level: advanced

    1897: .seealso: SVDTRLanczosSetKSP()
    1898: @*/
    1899: PetscErrorCode SVDTRLanczosGetKSP(SVD svd,KSP *ksp)
    1900: {
    1901:   PetscFunctionBegin;
    1903:   PetscAssertPointer(ksp,2);
    1904:   PetscUseMethod(svd,"SVDTRLanczosGetKSP_C",(SVD,KSP*),(svd,ksp));
    1905:   PetscFunctionReturn(PETSC_SUCCESS);
    1906: }

    1908: static PetscErrorCode SVDTRLanczosSetRestart_TRLanczos(SVD svd,PetscReal keep)
    1909: {
    1910:   SVD_TRLANCZOS *ctx = (SVD_TRLANCZOS*)svd->data;

    1912:   PetscFunctionBegin;
    1913:   if (keep==(PetscReal)PETSC_DEFAULT) ctx->keep = 0.5;
    1914:   else {
    1915:     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);
    1916:     ctx->keep = keep;
    1917:   }
    1918:   PetscFunctionReturn(PETSC_SUCCESS);
    1919: }

    1921: /*@
    1922:    SVDTRLanczosSetRestart - Sets the restart parameter for the thick-restart
    1923:    Lanczos method, in particular the proportion of basis vectors that must be
    1924:    kept after restart.

    1926:    Logically Collective

    1928:    Input Parameters:
    1929: +  svd  - the singular value solver
    1930: -  keep - the number of vectors to be kept at restart

    1932:    Options Database Key:
    1933: .  -svd_trlanczos_restart - Sets the restart parameter

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

    1938:    Level: advanced

    1940: .seealso: SVDTRLanczosGetRestart()
    1941: @*/
    1942: PetscErrorCode SVDTRLanczosSetRestart(SVD svd,PetscReal keep)
    1943: {
    1944:   PetscFunctionBegin;
    1947:   PetscTryMethod(svd,"SVDTRLanczosSetRestart_C",(SVD,PetscReal),(svd,keep));
    1948:   PetscFunctionReturn(PETSC_SUCCESS);
    1949: }

    1951: static PetscErrorCode SVDTRLanczosGetRestart_TRLanczos(SVD svd,PetscReal *keep)
    1952: {
    1953:   SVD_TRLANCZOS *ctx = (SVD_TRLANCZOS*)svd->data;

    1955:   PetscFunctionBegin;
    1956:   *keep = ctx->keep;
    1957:   PetscFunctionReturn(PETSC_SUCCESS);
    1958: }

    1960: /*@
    1961:    SVDTRLanczosGetRestart - Gets the restart parameter used in the thick-restart
    1962:    Lanczos method.

    1964:    Not Collective

    1966:    Input Parameter:
    1967: .  svd - the singular value solver

    1969:    Output Parameter:
    1970: .  keep - the restart parameter

    1972:    Level: advanced

    1974: .seealso: SVDTRLanczosSetRestart()
    1975: @*/
    1976: PetscErrorCode SVDTRLanczosGetRestart(SVD svd,PetscReal *keep)
    1977: {
    1978:   PetscFunctionBegin;
    1980:   PetscAssertPointer(keep,2);
    1981:   PetscUseMethod(svd,"SVDTRLanczosGetRestart_C",(SVD,PetscReal*),(svd,keep));
    1982:   PetscFunctionReturn(PETSC_SUCCESS);
    1983: }

    1985: static PetscErrorCode SVDTRLanczosSetLocking_TRLanczos(SVD svd,PetscBool lock)
    1986: {
    1987:   SVD_TRLANCZOS *ctx = (SVD_TRLANCZOS*)svd->data;

    1989:   PetscFunctionBegin;
    1990:   ctx->lock = lock;
    1991:   PetscFunctionReturn(PETSC_SUCCESS);
    1992: }

    1994: /*@
    1995:    SVDTRLanczosSetLocking - Choose between locking and non-locking variants of
    1996:    the thick-restart Lanczos method.

    1998:    Logically Collective

    2000:    Input Parameters:
    2001: +  svd  - the singular value solver
    2002: -  lock - true if the locking variant must be selected

    2004:    Options Database Key:
    2005: .  -svd_trlanczos_locking - Sets the locking flag

    2007:    Notes:
    2008:    The default is to lock converged singular triplets when the method restarts.
    2009:    This behaviour can be changed so that all directions are kept in the
    2010:    working subspace even if already converged to working accuracy (the
    2011:    non-locking variant).

    2013:    Level: advanced

    2015: .seealso: SVDTRLanczosGetLocking()
    2016: @*/
    2017: PetscErrorCode SVDTRLanczosSetLocking(SVD svd,PetscBool lock)
    2018: {
    2019:   PetscFunctionBegin;
    2022:   PetscTryMethod(svd,"SVDTRLanczosSetLocking_C",(SVD,PetscBool),(svd,lock));
    2023:   PetscFunctionReturn(PETSC_SUCCESS);
    2024: }

    2026: static PetscErrorCode SVDTRLanczosGetLocking_TRLanczos(SVD svd,PetscBool *lock)
    2027: {
    2028:   SVD_TRLANCZOS *ctx = (SVD_TRLANCZOS*)svd->data;

    2030:   PetscFunctionBegin;
    2031:   *lock = ctx->lock;
    2032:   PetscFunctionReturn(PETSC_SUCCESS);
    2033: }

    2035: /*@
    2036:    SVDTRLanczosGetLocking - Gets the locking flag used in the thick-restart
    2037:    Lanczos method.

    2039:    Not Collective

    2041:    Input Parameter:
    2042: .  svd - the singular value solver

    2044:    Output Parameter:
    2045: .  lock - the locking flag

    2047:    Level: advanced

    2049: .seealso: SVDTRLanczosSetLocking()
    2050: @*/
    2051: PetscErrorCode SVDTRLanczosGetLocking(SVD svd,PetscBool *lock)
    2052: {
    2053:   PetscFunctionBegin;
    2055:   PetscAssertPointer(lock,2);
    2056:   PetscUseMethod(svd,"SVDTRLanczosGetLocking_C",(SVD,PetscBool*),(svd,lock));
    2057:   PetscFunctionReturn(PETSC_SUCCESS);
    2058: }

    2060: static PetscErrorCode SVDTRLanczosSetExplicitMatrix_TRLanczos(SVD svd,PetscBool explicitmat)
    2061: {
    2062:   SVD_TRLANCZOS *lanczos = (SVD_TRLANCZOS*)svd->data;

    2064:   PetscFunctionBegin;
    2065:   if (lanczos->explicitmatrix != explicitmat) {
    2066:     lanczos->explicitmatrix = explicitmat;
    2067:     svd->state = SVD_STATE_INITIAL;
    2068:   }
    2069:   PetscFunctionReturn(PETSC_SUCCESS);
    2070: }

    2072: /*@
    2073:    SVDTRLanczosSetExplicitMatrix - Indicate if the matrix Z=[A;B] must
    2074:    be built explicitly.

    2076:    Logically Collective

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

    2082:    Options Database Key:
    2083: .  -svd_trlanczos_explicitmatrix <boolean> - Indicates the boolean flag

    2085:    Notes:
    2086:    This option is relevant for the GSVD case only.
    2087:    Z is the coefficient matrix of the KSP solver used internally.

    2089:    Level: advanced

    2091: .seealso: SVDTRLanczosGetExplicitMatrix()
    2092: @*/
    2093: PetscErrorCode SVDTRLanczosSetExplicitMatrix(SVD svd,PetscBool explicitmat)
    2094: {
    2095:   PetscFunctionBegin;
    2098:   PetscTryMethod(svd,"SVDTRLanczosSetExplicitMatrix_C",(SVD,PetscBool),(svd,explicitmat));
    2099:   PetscFunctionReturn(PETSC_SUCCESS);
    2100: }

    2102: static PetscErrorCode SVDTRLanczosGetExplicitMatrix_TRLanczos(SVD svd,PetscBool *explicitmat)
    2103: {
    2104:   SVD_TRLANCZOS *lanczos = (SVD_TRLANCZOS*)svd->data;

    2106:   PetscFunctionBegin;
    2107:   *explicitmat = lanczos->explicitmatrix;
    2108:   PetscFunctionReturn(PETSC_SUCCESS);
    2109: }

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

    2114:    Not Collective

    2116:    Input Parameter:
    2117: .  svd  - singular value solver

    2119:    Output Parameter:
    2120: .  explicitmat - the mode flag

    2122:    Level: advanced

    2124: .seealso: SVDTRLanczosSetExplicitMatrix()
    2125: @*/
    2126: PetscErrorCode SVDTRLanczosGetExplicitMatrix(SVD svd,PetscBool *explicitmat)
    2127: {
    2128:   PetscFunctionBegin;
    2130:   PetscAssertPointer(explicitmat,2);
    2131:   PetscUseMethod(svd,"SVDTRLanczosGetExplicitMatrix_C",(SVD,PetscBool*),(svd,explicitmat));
    2132:   PetscFunctionReturn(PETSC_SUCCESS);
    2133: }

    2135: static PetscErrorCode SVDTRLanczosSetScale_TRLanczos(SVD svd,PetscReal scale)
    2136: {
    2137:   SVD_TRLANCZOS *ctx = (SVD_TRLANCZOS*)svd->data;

    2139:   PetscFunctionBegin;
    2140:   if (scale<0) {
    2141:     ctx->scalef  = 1.0;
    2142:     ctx->scaleth = -scale;
    2143:   } else {
    2144:     ctx->scalef  = scale;
    2145:     ctx->scaleth = 0.0;
    2146:   }
    2147:   PetscFunctionReturn(PETSC_SUCCESS);
    2148: }

    2150: /*@
    2151:    SVDTRLanczosSetScale - Sets the scale parameter for the GSVD.

    2153:    Logically Collective

    2155:    Input Parameters:
    2156: +  svd   - singular value solver
    2157: -  scale - scale parameter

    2159:    Options Database Key:
    2160: .  -svd_trlanczos_scale <real> - scale factor/threshold

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

    2171:    Level: advanced

    2173: .seealso: SVDTRLanczosGetScale()
    2174: @*/
    2175: PetscErrorCode SVDTRLanczosSetScale(SVD svd,PetscReal scale)
    2176: {
    2177:   PetscFunctionBegin;
    2180:   PetscTryMethod(svd,"SVDTRLanczosSetScale_C",(SVD,PetscReal),(svd,scale));
    2181:   PetscFunctionReturn(PETSC_SUCCESS);
    2182: }

    2184: static PetscErrorCode SVDTRLanczosGetScale_TRLanczos(SVD svd,PetscReal *scale)
    2185: {
    2186:   SVD_TRLANCZOS *ctx = (SVD_TRLANCZOS*)svd->data;

    2188:   PetscFunctionBegin;
    2189:   if (ctx->scaleth==0) *scale = ctx->scalef;
    2190:   else                 *scale = -ctx->scaleth;
    2191:   PetscFunctionReturn(PETSC_SUCCESS);
    2192: }

    2194: /*@
    2195:    SVDTRLanczosGetScale - Gets the scale parameter for the GSVD.

    2197:    Not Collective

    2199:    Input Parameter:
    2200: .  svd - the singular value solver

    2202:    Output Parameter:
    2203: .  scale - the scale parameter

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

    2210:    Level: advanced

    2212: .seealso: SVDTRLanczosSetScale()
    2213: @*/
    2214: PetscErrorCode SVDTRLanczosGetScale(SVD svd,PetscReal *scale)
    2215: {
    2216:   PetscFunctionBegin;
    2218:   PetscAssertPointer(scale,2);
    2219:   PetscUseMethod(svd,"SVDTRLanczosGetScale_C",(SVD,PetscReal*),(svd,scale));
    2220:   PetscFunctionReturn(PETSC_SUCCESS);
    2221: }

    2223: static PetscErrorCode SVDReset_TRLanczos(SVD svd)
    2224: {
    2225:   SVD_TRLANCZOS  *lanczos = (SVD_TRLANCZOS*)svd->data;

    2227:   PetscFunctionBegin;
    2228:   if (svd->isgeneralized || (!svd->problem_type && svd->OPb)) {
    2229:     PetscCall(KSPReset(lanczos->ksp));
    2230:     PetscCall(MatDestroy(&lanczos->Z));
    2231:   }
    2232:   PetscFunctionReturn(PETSC_SUCCESS);
    2233: }

    2235: static PetscErrorCode SVDDestroy_TRLanczos(SVD svd)
    2236: {
    2237:   SVD_TRLANCZOS  *lanczos = (SVD_TRLANCZOS*)svd->data;

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

    2259: static PetscErrorCode SVDView_TRLanczos(SVD svd,PetscViewer viewer)
    2260: {
    2261:   SVD_TRLANCZOS  *lanczos = (SVD_TRLANCZOS*)svd->data;
    2262:   PetscBool      isascii;

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

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

    2290: static PetscErrorCode SVDSetDSType_TRLanczos(SVD svd)
    2291: {
    2292:   SVD_TRLANCZOS  *lanczos = (SVD_TRLANCZOS*)svd->data;
    2293:   DSType         dstype;

    2295:   PetscFunctionBegin;
    2296:   dstype = svd->ishyperbolic? DSHSVD: DSSVD;
    2297:   if (svd->OPb && (lanczos->bidiag==SVD_TRLANCZOS_GBIDIAG_UPPER || lanczos->bidiag==SVD_TRLANCZOS_GBIDIAG_LOWER)) dstype = DSGSVD;
    2298:   PetscCall(DSSetType(svd->ds,dstype));
    2299:   PetscFunctionReturn(PETSC_SUCCESS);
    2300: }

    2302: SLEPC_EXTERN PetscErrorCode SVDCreate_TRLanczos(SVD svd)
    2303: {
    2304:   SVD_TRLANCZOS  *ctx;

    2306:   PetscFunctionBegin;
    2307:   PetscCall(PetscNew(&ctx));
    2308:   svd->data = (void*)ctx;

    2310:   ctx->lock    = PETSC_TRUE;
    2311:   ctx->bidiag  = SVD_TRLANCZOS_GBIDIAG_LOWER;
    2312:   ctx->scalef  = 1.0;
    2313:   ctx->scaleth = 0.0;

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