Actual source code: ks-harm.c

  1: /*                       

  3:    SLEPc eigensolver: "krylovschur"

  5:    Method: Krylov-Schur

  7:    Algorithm:

  9:        Single-vector Krylov-Schur method for both symmetric and non-symmetric
 10:        problems.

 12:    References:

 14:        [1] "Krylov-Schur Methods in SLEPc", SLEPc Technical Report STR-7, 
 15:            available at http://www.grycap.upv.es/slepc.

 17:        [2] G.W. Stewart, "A Krylov-Schur Algorithm for Large Eigenproblems",
 18:            SIAM J. Matrix Analysis and App., 23(3), pp. 601-614, 2001. 

 20:    Last update: Feb 2009

 22:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 23:    SLEPc - Scalable Library for Eigenvalue Problem Computations
 24:    Copyright (c) 2002-2010, Universidad Politecnica de Valencia, Spain

 26:    This file is part of SLEPc.
 27:       
 28:    SLEPc is free software: you can redistribute it and/or modify it under  the
 29:    terms of version 3 of the GNU Lesser General Public License as published by
 30:    the Free Software Foundation.

 32:    SLEPc  is  distributed in the hope that it will be useful, but WITHOUT  ANY 
 33:    WARRANTY;  without even the implied warranty of MERCHANTABILITY or  FITNESS 
 34:    FOR  A  PARTICULAR PURPOSE. See the GNU Lesser General Public  License  for 
 35:    more details.

 37:    You  should have received a copy of the GNU Lesser General  Public  License
 38:    along with SLEPc. If not, see <http://www.gnu.org/licenses/>.
 39:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 40: */

 42:  #include private/epsimpl.h
 43:  #include slepcblaslapack.h

 47: /*
 48:    EPSTranslateHarmonic - Computes a translation of the Krylov decomposition
 49:    in order to perform a harmonic extraction.

 51:    On input:
 52:      S is the Rayleigh quotient (order m, leading dimension is lds)
 53:      tau is the translation amount
 54:      b is assumed to be beta*e_m^T

 56:    On output:
 57:      g = (B-sigma*eye(m))'\b
 58:      S is updated as S + g*b'

 60:    Workspace:
 61:      work is workspace to store a working copy of S and the pivots (int 
 62:      of length m)
 63: */
 64: PetscErrorCode EPSTranslateHarmonic(PetscInt m_,PetscScalar *S,PetscInt lds,PetscScalar tau,PetscScalar beta,PetscScalar *g,PetscScalar *work)
 65: {
 66: #if defined(PETSC_MISSING_LAPACK_GETRF) || defined(PETSC_MISSING_LAPACK_GETRS) 
 68:   SETERRQ(PETSC_ERR_SUP,"GETRF,GETRS - Lapack routines are unavailable.");
 69: #else
 71:   PetscInt       i,j;
 72:   PetscBLASInt   info,m,one = 1;
 73:   PetscScalar    *B = work;
 74:   PetscBLASInt   *ipiv = (PetscBLASInt*)(work+m_*m_);

 77:   m = PetscBLASIntCast(m_);
 78:   /* Copy S to workspace B */
 79:   for (i=0;i<m;i++)
 80:     for (j=0;j<m;j++)
 81:       B[i+j*m] = S[i+j*lds];
 82:   /* Vector g initialy stores b */
 83:   PetscMemzero(g,m*sizeof(PetscScalar));
 84:   g[m-1] = beta;
 85: 
 86:   /* g = (B-sigma*eye(m))'\b */
 87:   for (i=0;i<m;i++)
 88:     B[i+i*m] -= tau;
 89:   LAPACKgetrf_(&m,&m,B,&m,ipiv,&info);
 90:   if (info<0) SETERRQ(PETSC_ERR_LIB,"Bad argument to LU factorization");
 91:   if (info>0) SETERRQ(PETSC_ERR_MAT_LU_ZRPVT,"Bad LU factorization");
 92:   PetscLogFlops(2.0*m*m*m/3.0);
 93:   LAPACKgetrs_("C",&m,&one,B,&m,ipiv,g,&m,&info);
 94:   if (info) SETERRQ(PETSC_ERR_LIB,"GETRS - Bad solve");
 95:   PetscLogFlops(2.0*m*m-m);

 97:   /* S = S + g*b' */
 98:   for (i=0;i<m;i++)
 99:     S[i+(m-1)*lds] = S[i+(m-1)*lds] + g[i]*beta;

101:   return(0);
102: #endif
103: }

107: /*
108:    EPSRecoverHarmonic - Computes a translation of the truncated Krylov 
109:    decomposition in order to recover the original non-translated state

111:    On input:
112:      S is the truncated Rayleigh quotient (size n, leading dimension m)
113:      k and l indicate the active columns of S
114:      [U, u] is the basis of the Krylov subspace
115:      g is the vector computed in the original translation
116:      Q is the similarity transformation used to reduce to sorted Schur form

118:    On output:
119:      S is updated as S + g*b'
120:      u is re-orthonormalized with respect to U
121:      b is re-scaled
122:      g is destroyed

124:    Workspace:
125:      ghat is workspace to store a vector of length n
126: */
127: PetscErrorCode EPSRecoverHarmonic(PetscScalar *S,PetscInt n_,PetscInt k,PetscInt l,PetscInt m_,PetscScalar *g,PetscScalar *Q,Vec *U,Vec u,PetscScalar *ghat)
128: {
130:   PetscBLASInt   one=1,ncol=k+l,n,m;
131:   PetscScalar    done=1.0,dmone=-1.0,dzero=0.0;
132:   PetscReal      gamma,gnorm;
133:   PetscBLASInt   i,j;

136:   n = PetscBLASIntCast(n_);
137:   m = PetscBLASIntCast(m_);

139:   /* g^ = -Q(:,idx)'*g */
140:   BLASgemv_("C",&n,&ncol,&dmone,Q,&n,g,&one,&dzero,ghat,&one);

142:   /* S = S + g^*b' */
143:   for (i=0;i<k+l;i++) {
144:     for (j=k;j<k+l;j++) {
145:       S[i+j*m] += ghat[i]*S[k+l+j*m];
146:     }
147:   }

149:   /* g~ = (I-Q(:,idx)*Q(:,idx)')*g = g+Q(:,idx)*g^ */
150:   BLASgemv_("N",&n,&ncol,&done,Q,&n,ghat,&one,&done,g,&one);

152:   /* gamma u^ = u - U*g~ */
153:   SlepcVecMAXPBY(u,1.0,-1.0,m,g,U);

155:   /* Renormalize u */
156:   gnorm = 0.0;
157:   for (i=0;i<n;i++)
158:     gnorm = gnorm + PetscRealPart(g[i]*PetscConj(g[i]));
159:   gamma = sqrt(1.0+gnorm);
160:   VecScale(u,1.0/gamma);

162:   /* b = gamma*b */
163:   for (i=k;i<k+l;i++) {
164:     S[i*m+k+l] *= gamma;
165:   }
166:   return(0);
167: }

171: PetscErrorCode EPSSolve_KRYLOVSCHUR_HARMONIC(EPS eps)
172: {
174:   PetscInt       i,k,l,lwork,nv;
175:   Vec            u=eps->work[0];
176:   PetscScalar    *S=eps->T,*Q,*g,*work;
177:   PetscReal      beta,gnorm;
178:   PetscTruth     breakdown;

181:   PetscMemzero(S,eps->ncv*eps->ncv*sizeof(PetscScalar));
182:   PetscMalloc(eps->ncv*eps->ncv*sizeof(PetscScalar),&Q);
183:   lwork = PetscMax((eps->ncv+1)*eps->ncv,7*eps->ncv);
184:   PetscMalloc(lwork*sizeof(PetscScalar),&work);
185:   PetscMalloc(eps->ncv*sizeof(PetscScalar),&g);

187:   /* Get the starting Arnoldi vector */
188:   EPSGetStartVector(eps,0,eps->V[0],PETSC_NULL);
189:   l = 0;
190: 
191:   /* Restart loop */
192:   while (eps->reason == EPS_CONVERGED_ITERATING) {
193:     eps->its++;

195:     /* Compute an nv-step Arnoldi factorization */
196:     nv = PetscMin(eps->nconv+eps->mpd,eps->ncv);
197:     EPSBasicArnoldi(eps,PETSC_FALSE,S,eps->ncv,eps->V,eps->nconv+l,&nv,u,&beta,&breakdown);
198:     VecScale(u,1.0/beta);

200:     /* Compute translation of Krylov decomposition */
201:     EPSTranslateHarmonic(nv,S,eps->ncv,eps->target,(PetscScalar)beta,g,work);
202:     gnorm = 0.0;
203:     for (i=0;i<nv;i++)
204:       gnorm = gnorm + PetscRealPart(g[i]*PetscConj(g[i]));

206:     /* Solve projected problem and compute residual norm estimates */
207:     EPSProjectedKSNonsym(eps,l,S,eps->ncv,Q,nv);

209:     /* Check convergence */
210:     EPSKrylovConvergence(eps,PETSC_FALSE,eps->nconv,nv-eps->nconv,S,eps->ncv,Q,eps->V,nv,beta,sqrt(1.0+gnorm),&k,work);
211:     if (eps->its >= eps->max_it) eps->reason = EPS_DIVERGED_ITS;
212:     if (k >= eps->nev) eps->reason = EPS_CONVERGED_TOL;
213: 
214:     /* Update l */
215:     if (eps->reason != EPS_CONVERGED_ITERATING || breakdown) l = 0;
216:     else {
217:       l = (nv-k)/2;
218: #if !defined(PETSC_USE_COMPLEX)
219:       if (S[(k+l-1)*(eps->ncv+1)+1] != 0.0) {
220:         if (k+l<nv-1) l = l+1;
221:         else l = l-1;
222:       }
223: #endif
224:     }
225: 
226:     if (eps->reason == EPS_CONVERGED_ITERATING) {
227:       if (breakdown) {
228:         /* Start a new Arnoldi factorization */
229:         PetscInfo2(eps,"Breakdown in Krylov-Schur method (it=%i norm=%g)\n",eps->its,beta);
230:         EPSGetStartVector(eps,k,eps->V[k],&breakdown);
231:         if (breakdown) {
232:           eps->reason = EPS_DIVERGED_BREAKDOWN;
233:           PetscInfo(eps,"Unable to generate more start vectors\n");
234:         }
235:       } else {
236:         /* Prepare the Rayleigh quotient for restart */
237:         for (i=k;i<k+l;i++) {
238:           S[i*eps->ncv+k+l] = Q[(i+1)*nv-1]*beta;
239:         }
240:         EPSRecoverHarmonic(S,nv,k,l,eps->ncv,g,Q,eps->V,u,work);
241:       }
242:     }
243:     /* Update the corresponding vectors V(:,idx) = V*Q(:,idx) */
244:     SlepcUpdateVectors(nv,eps->V,eps->nconv,k+l,Q,nv,PETSC_FALSE);
245: 
246:     if (eps->reason == EPS_CONVERGED_ITERATING && !breakdown) {
247:       VecCopy(u,eps->V[k+l]);
248:     }
249:     eps->nconv = k;

251:     EPSMonitor(eps,eps->its,eps->nconv,eps->eigr,eps->eigi,eps->errest,nv);
252: 
253:   }

255:   PetscFree(Q);
256:   PetscFree(work);
257:   PetscFree(g);
258:   return(0);
259: }