Date: 2021-09-20T09:44:14+00:00

Actual source code: lmekrylov.c
slepc-3.15.2 2021-09-20
Report Typos and Errors

      1: /*
      2:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      3:    SLEPc - Scalable Library for Eigenvalue Problem Computations
      4:    Copyright (c) 2002-2021, 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 matrix equation solver: "krylov"

     13:    Method: Arnoldi with Eiermann-Ernst restart

     15:    Algorithm:

     17:        Project the equation onto the Arnoldi basis and solve the compressed
     18:        equation the Hessenberg matrix H, restart by discarding the Krylov
     19:        basis but keeping H.

     21:    References:

     23:        [1] Y. Saad, "Numerical solution of large Lyapunov equations", in
     24:            Signal processing, scattering and operator theory, and numerical
     25:            methods, vol. 5 of Progr. Systems Control Theory, pages 503-511,
     26:            1990.

     28:        [2] D. Kressner, "Memory-efficient Krylov subspace techniques for
     29:            solving large-scale Lyapunov equations", in 2008 IEEE Int. Conf.
     30:            Computer-Aided Control Systems, pages 613-618, 2008.
     31: */

     33: #include <slepc/private/lmeimpl.h>
     34: #include <slepcblaslapack.h>

     36: PetscErrorCode LMESetUp_Krylov(LME lme)
     37: {
     39:   PetscInt       N;

     42:   MatGetSize(lme->A,&N,NULL);
     43:   if (lme->ncv==PETSC_DEFAULT) lme->ncv = PetscMin(30,N);
     44:   if (lme->max_it==PETSC_DEFAULT) lme->max_it = 100;
     45:   LMEAllocateSolution(lme,1);
     46:   return(0);
     47: }

     49: PetscErrorCode LMESolve_Krylov_Lyapunov_Vec(LME lme,Vec b,PetscBool fixed,PetscInt rrank,BV C1,BV *X1,PetscInt *col,PetscBool *fail,PetscInt *totalits)
     50: {
     52:   PetscInt       n=0,m,ldh,ldg=0,i,j,rank=0,lrank,pass,nouter=0,its;
     53:   PetscReal      bnorm,beta,errest;
     54:   PetscBool      breakdown;
     55:   PetscScalar    *H,*G=NULL,*Gnew=NULL,*L,*U,*r,*Qarray,sone=1.0,zero=0.0;
     56:   PetscBLASInt   n_,m_,rk_;
     57:   Mat            Q;

     60:   *fail = PETSC_FALSE;
     61:   its = 0;
     62:   m  = lme->ncv;
     63:   ldh = m+1;
     64:   PetscCalloc1(ldh*m,&H);

     66:   VecNorm(b,NORM_2,&bnorm);
     67:   if (!bnorm) SETERRQ(PetscObjectComm((PetscObject)lme),PETSC_ERR_ARG_WRONG,"Cannot process a zero vector in the right-hand side");

     69:   for (pass=0;pass<2;pass++) {

     71:     /* set initial vector to b/||b|| */
     72:     BVInsertVec(lme->V,0,b);
     73:     BVScaleColumn(lme->V,0,1.0/bnorm);

     75:     /* Restart loop */
     76:     while ((pass==0 && !*fail) || (pass==1 && its+1<nouter)) {
     77:       its++;

     79:       /* compute Arnoldi factorization */
     80:       BVMatArnoldi(lme->V,lme->A,H,ldh,0,&m,&beta,&breakdown);

     82:       if (pass==0) {
     83:         /* glue together the previous H and the new H obtained with Arnoldi */
     84:         ldg = n+m+1;
     85:         PetscCalloc1(ldg*(n+m),&Gnew);
     86:         for (j=0;j<m;j++) {
     87:           PetscArraycpy(Gnew+n+(j+n)*ldg,H+j*ldh,m);
     88:         }
     89:         Gnew[n+m+(n+m-1)*ldg] = beta;
     90:         if (G) {
     91:           for (j=0;j<n;j++) {
     92:             PetscArraycpy(Gnew+j*ldg,G+j*(n+1),n+1);
     93:           }
     94:           PetscFree(G);
     95:         }
     96:         G = Gnew;
     97:         n += m;
     98:       } else {
     99:         /* update Z = Z + V(:,1:m)*Q    with   Q=U(blk,:)*P(1:nrk,:)'  */
    100:         MatCreateSeqDense(PETSC_COMM_SELF,m,*col+rank,NULL,&Q);
    101:         MatDenseGetArray(Q,&Qarray);
    102:         PetscBLASIntCast(m,&m_);
    103:         PetscBLASIntCast(n,&n_);
    104:         PetscBLASIntCast(rank,&rk_);
    105:         PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&m_,&rk_,&rk_,&sone,U+its*m,&n_,L,&n_,&zero,Qarray+(*col)*m,&m_));
    106:         MatDenseRestoreArray(Q,&Qarray);
    107:         BVSetActiveColumns(*X1,*col,*col+rank);
    108:         BVMult(*X1,1.0,1.0,lme->V,Q);
    109:         MatDestroy(&Q);
    110:       }

    112:       if (pass==0) {
    113:         /* solve compressed Lyapunov equation */
    114:         PetscCalloc1(n,&r);
    115:         PetscCalloc1(n*n,&L);
    116:         r[0] = bnorm;
    117:         errest = PetscAbsScalar(G[n+(n-1)*ldg]);
    118:         LMEDenseHessLyapunovChol(lme,n,G,ldg,1,r,n,L,n,&errest);
    119:         LMEMonitor(lme,*totalits+its,errest);
    120:         PetscFree(r);

    122:         /* check convergence */
    123:         if (errest<lme->tol) {
    124:           lme->errest += errest;
    125:           PetscMalloc1(n*n,&U);
    126:           /* transpose L */
    127:           for (j=0;j<n;j++) {
    128:             for (i=j+1;i<n;i++) {
    129:               L[i+j*n] = PetscConj(L[j+i*n]);
    130:               L[j+i*n] = 0.0;
    131:             }
    132:           }
    133:           LMEDenseRankSVD(lme,n,L,n,U,n,&lrank);
    134:           PetscInfo1(lme,"Rank of the Cholesky factor = %D\n",lrank);
    135:           nouter = its;
    136:           its = -1;
    137:           if (!fixed) {  /* X1 was not set by user, allocate it with rank columns */
    138:             rank = lrank;
    139:             if (*col) {
    140:               BVResize(*X1,*col+rank,PETSC_TRUE);
    141:             } else {
    142:               BVDuplicateResize(C1,rank,X1);
    143:             }
    144:           } else rank = PetscMin(lrank,rrank);
    145:           PetscFree(G);
    146:           break;
    147:         } else {
    148:           PetscFree(L);
    149:           if (*totalits+its>=lme->max_it) *fail = PETSC_TRUE;
    150:         }
    151:       }

    153:       /* restart with vector v_{m+1} */
    154:       if (!*fail) {
    155:         BVCopyColumn(lme->V,m,0);
    156:       }
    157:     }
    158:   }

    160:   *col += rank;
    161:   *totalits += its+1;
    162:   PetscFree(H);
    163:   if (L) { PetscFree(L); }
    164:   if (U) { PetscFree(U); }
    165:   return(0);
    166: }

    168: PetscErrorCode LMESolve_Krylov_Lyapunov(LME lme)
    169: {
    171:   PetscBool      fail,fixed = lme->X? PETSC_TRUE: PETSC_FALSE;
    172:   PetscInt       i,k,rank=0,col=0;
    173:   Vec            b;
    174:   BV             X1=NULL,C1;
    175:   Mat            X1m,X1t,C1m;

    178:   MatLRCGetMats(lme->C,NULL,&C1m,NULL,NULL);
    179:   BVCreateFromMat(C1m,&C1);
    180:   BVSetFromOptions(C1);
    181:   BVGetActiveColumns(C1,NULL,&k);
    182:   if (fixed) {
    183:     MatLRCGetMats(lme->X,NULL,&X1m,NULL,NULL);
    184:     BVCreateFromMat(X1m,&X1);
    185:     BVSetFromOptions(X1);
    186:     BVGetActiveColumns(X1,NULL,&rank);
    187:     rank = rank/k;
    188:   }
    189:   for (i=0;i<k;i++) {
    190:     BVGetColumn(C1,i,&b);
    191:     LMESolve_Krylov_Lyapunov_Vec(lme,b,fixed,rank,C1,&X1,&col,&fail,&lme->its);
    192:     BVRestoreColumn(C1,i,&b);
    193:     if (fail) {
    194:       lme->reason = LME_DIVERGED_ITS;
    195:       break;
    196:     }
    197:   }
    198:   if (lme->reason==LME_CONVERGED_ITERATING) lme->reason = LME_CONVERGED_TOL;
    199:   BVCreateMat(X1,&X1t);
    200:   if (fixed) {
    201:     MatCopy(X1t,X1m,SAME_NONZERO_PATTERN);
    202:   } else {
    203:     MatCreateLRC(NULL,X1t,NULL,NULL,&lme->X);
    204:   }
    205:   MatDestroy(&X1t);
    206:   BVDestroy(&C1);
    207:   BVDestroy(&X1);
    208:   return(0);
    209: }

    211: SLEPC_EXTERN PetscErrorCode LMECreate_Krylov(LME lme)
    212: {
    214:   lme->ops->solve[LME_LYAPUNOV]      = LMESolve_Krylov_Lyapunov;
    215:   lme->ops->setup                    = LMESetUp_Krylov;
    216:   return(0);
    217: }