Actual source code: lmekrylov.c
slepc-3.19.0 2023-03-31
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 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: {
38: PetscInt N;
40: PetscFunctionBegin;
41: PetscCall(MatGetSize(lme->A,&N,NULL));
42: if (lme->ncv==PETSC_DEFAULT) lme->ncv = PetscMin(30,N);
43: if (lme->max_it==PETSC_DEFAULT) lme->max_it = 100;
44: PetscCall(LMEAllocateSolution(lme,1));
45: PetscFunctionReturn(PETSC_SUCCESS);
46: }
48: PetscErrorCode LMESolve_Krylov_Lyapunov_Vec(LME lme,Vec b,PetscBool fixed,PetscInt rrank,BV C1,BV *X1,PetscInt *col,PetscBool *fail,PetscInt *totalits)
49: {
50: PetscInt n=0,m,ldh,ldg=0,i,j,rank=0,lrank,pass,nouter=0,its;
51: PetscReal bnorm,beta,errest;
52: PetscBool breakdown;
53: PetscScalar *Harray,*G=NULL,*Gnew=NULL,*L,*U,*r,*Qarray,sone=1.0,zero=0.0;
54: PetscBLASInt n_,m_,rk_;
55: Mat Q,H;
57: PetscFunctionBegin;
58: *fail = PETSC_FALSE;
59: its = 0;
60: m = lme->ncv;
61: ldh = m+1;
62: PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,ldh,m,NULL,&H));
63: PetscCall(MatDenseGetArray(H,&Harray));
65: PetscCall(VecNorm(b,NORM_2,&bnorm));
66: PetscCheck(bnorm,PetscObjectComm((PetscObject)lme),PETSC_ERR_ARG_WRONG,"Cannot process a zero vector in the right-hand side");
68: for (pass=0;pass<2;pass++) {
70: /* set initial vector to b/||b|| */
71: PetscCall(BVInsertVec(lme->V,0,b));
72: PetscCall(BVScaleColumn(lme->V,0,1.0/bnorm));
74: /* Restart loop */
75: while ((pass==0 && !*fail) || (pass==1 && its+1<nouter)) {
76: its++;
78: /* compute Arnoldi factorization */
79: PetscCall(BVMatArnoldi(lme->V,lme->A,H,0,&m,&beta,&breakdown));
80: PetscCall(BVSetActiveColumns(lme->V,0,m));
82: if (pass==0) {
83: /* glue together the previous H and the new H obtained with Arnoldi */
84: ldg = n+m+1;
85: PetscCall(PetscCalloc1(ldg*(n+m),&Gnew));
86: for (j=0;j<m;j++) PetscCall(PetscArraycpy(Gnew+n+(j+n)*ldg,Harray+j*ldh,m));
87: Gnew[n+m+(n+m-1)*ldg] = beta;
88: if (G) {
89: for (j=0;j<n;j++) PetscCall(PetscArraycpy(Gnew+j*ldg,G+j*(n+1),n+1));
90: PetscCall(PetscFree(G));
91: }
92: G = Gnew;
93: n += m;
94: } else {
95: /* update Z = Z + V(:,1:m)*Q with Q=U(blk,:)*P(1:nrk,:)' */
96: PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,m,*col+rank,NULL,&Q));
97: PetscCall(MatDenseGetArray(Q,&Qarray));
98: PetscCall(PetscBLASIntCast(m,&m_));
99: PetscCall(PetscBLASIntCast(n,&n_));
100: PetscCall(PetscBLASIntCast(rank,&rk_));
101: PetscCallBLAS("BLASgemm",BLASgemm_("N","N",&m_,&rk_,&rk_,&sone,U+its*m,&n_,L,&n_,&zero,Qarray+(*col)*m,&m_));
102: PetscCall(MatDenseRestoreArray(Q,&Qarray));
103: PetscCall(BVSetActiveColumns(*X1,*col,*col+rank));
104: PetscCall(BVMult(*X1,1.0,1.0,lme->V,Q));
105: PetscCall(MatDestroy(&Q));
106: }
108: if (pass==0) {
109: /* solve compressed Lyapunov equation */
110: PetscCall(PetscCalloc1(n,&r));
111: PetscCall(PetscCalloc1(n*n,&L));
112: r[0] = bnorm;
113: errest = PetscAbsScalar(G[n+(n-1)*ldg]);
114: PetscCall(LMEDenseHessLyapunovChol(lme,n,G,ldg,1,r,n,L,n,&errest));
115: PetscCall(LMEMonitor(lme,*totalits+its,errest));
116: PetscCall(PetscFree(r));
118: /* check convergence */
119: if (errest<lme->tol) {
120: lme->errest += errest;
121: PetscCall(PetscMalloc1(n*n,&U));
122: /* transpose L */
123: for (j=0;j<n;j++) {
124: for (i=j+1;i<n;i++) {
125: L[i+j*n] = PetscConj(L[j+i*n]);
126: L[j+i*n] = 0.0;
127: }
128: }
129: PetscCall(LMEDenseRankSVD(lme,n,L,n,U,n,&lrank));
130: PetscCall(PetscInfo(lme,"Rank of the Cholesky factor = %" PetscInt_FMT "\n",lrank));
131: nouter = its;
132: its = -1;
133: if (!fixed) { /* X1 was not set by user, allocate it with rank columns */
134: rank = lrank;
135: if (*col) PetscCall(BVResize(*X1,*col+rank,PETSC_TRUE));
136: else PetscCall(BVDuplicateResize(C1,rank,X1));
137: } else rank = PetscMin(lrank,rrank);
138: PetscCall(PetscFree(G));
139: break;
140: } else {
141: PetscCall(PetscFree(L));
142: if (*totalits+its>=lme->max_it) *fail = PETSC_TRUE;
143: }
144: }
146: /* restart with vector v_{m+1} */
147: if (!*fail) PetscCall(BVCopyColumn(lme->V,m,0));
148: }
149: }
151: *col += rank;
152: *totalits += its+1;
153: PetscCall(MatDenseRestoreArray(H,&Harray));
154: PetscCall(MatDestroy(&H));
155: if (L) PetscCall(PetscFree(L));
156: if (U) PetscCall(PetscFree(U));
157: PetscFunctionReturn(PETSC_SUCCESS);
158: }
160: PetscErrorCode LMESolve_Krylov_Lyapunov(LME lme)
161: {
162: PetscBool fail,fixed = lme->X? PETSC_TRUE: PETSC_FALSE;
163: PetscInt i,k,rank=0,col=0;
164: Vec b;
165: BV X1=NULL,C1;
166: Mat X1m,X1t,C1m;
168: PetscFunctionBegin;
169: PetscCall(MatLRCGetMats(lme->C,NULL,&C1m,NULL,NULL));
170: PetscCall(BVCreateFromMat(C1m,&C1));
171: PetscCall(BVSetFromOptions(C1));
172: PetscCall(BVGetActiveColumns(C1,NULL,&k));
173: if (fixed) {
174: PetscCall(MatLRCGetMats(lme->X,NULL,&X1m,NULL,NULL));
175: PetscCall(BVCreateFromMat(X1m,&X1));
176: PetscCall(BVSetFromOptions(X1));
177: PetscCall(BVGetActiveColumns(X1,NULL,&rank));
178: rank = rank/k;
179: }
180: for (i=0;i<k;i++) {
181: PetscCall(BVGetColumn(C1,i,&b));
182: PetscCall(LMESolve_Krylov_Lyapunov_Vec(lme,b,fixed,rank,C1,&X1,&col,&fail,&lme->its));
183: PetscCall(BVRestoreColumn(C1,i,&b));
184: if (fail) {
185: lme->reason = LME_DIVERGED_ITS;
186: break;
187: }
188: }
189: if (lme->reason==LME_CONVERGED_ITERATING) lme->reason = LME_CONVERGED_TOL;
190: PetscCall(BVCreateMat(X1,&X1t));
191: if (fixed) PetscCall(MatCopy(X1t,X1m,SAME_NONZERO_PATTERN));
192: else PetscCall(MatCreateLRC(NULL,X1t,NULL,NULL,&lme->X));
193: PetscCall(MatDestroy(&X1t));
194: PetscCall(BVDestroy(&C1));
195: PetscCall(BVDestroy(&X1));
196: PetscFunctionReturn(PETSC_SUCCESS);
197: }
199: SLEPC_EXTERN PetscErrorCode LMECreate_Krylov(LME lme)
200: {
201: PetscFunctionBegin;
202: lme->ops->solve[LME_LYAPUNOV] = LMESolve_Krylov_Lyapunov;
203: lme->ops->setup = LMESetUp_Krylov;
204: PetscFunctionReturn(PETSC_SUCCESS);
205: }