Actual source code: krylov.c

  1: /*                       
  2:    Common subroutines for all Krylov-type solvers.

  4:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  5:    SLEPc - Scalable Library for Eigenvalue Problem Computations
  6:    Copyright (c) 2002-2011, Universitat Politecnica de Valencia, Spain

  8:    This file is part of SLEPc.
  9:       
 10:    SLEPc is free software: you can redistribute it and/or modify it under  the
 11:    terms of version 3 of the GNU Lesser General Public License as published by
 12:    the Free Software Foundation.

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

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

 24: #include <private/epsimpl.h>                /*I "slepceps.h" I*/
 25: #include <private/slepcimpl.h>              /*I "slepcsys.h" I*/
 26: #include <slepcblaslapack.h>

 30: /*
 31:    EPSBasicArnoldi - Computes an m-step Arnoldi factorization. The first k
 32:    columns are assumed to be locked and therefore they are not modified. On
 33:    exit, the following relation is satisfied:

 35:                     OP * V - V * H = f * e_m^T

 37:    where the columns of V are the Arnoldi vectors (which are B-orthonormal),
 38:    H is an upper Hessenberg matrix, f is the residual vector and e_m is
 39:    the m-th vector of the canonical basis. The vector f is B-orthogonal to
 40:    the columns of V. On exit, beta contains the B-norm of f and the next 
 41:    Arnoldi vector can be computed as v_{m+1} = f / beta. 
 42: */
 43: PetscErrorCode EPSBasicArnoldi(EPS eps,PetscBool trans,PetscScalar *H,PetscInt ldh,Vec *V,PetscInt k,PetscInt *M,Vec f,PetscReal *beta,PetscBool *breakdown)
 44: {
 46:   PetscInt       j,m = *M;
 47:   PetscReal      norm;

 50:   for (j=k;j<m-1;j++) {
 51:     if (trans) { STApplyTranspose(eps->OP,V[j],V[j+1]); }
 52:     else { STApply(eps->OP,V[j],V[j+1]); }
 53:     IPOrthogonalize(eps->ip,eps->nds,eps->DS,j+1,PETSC_NULL,V,V[j+1],H+ldh*j,&norm,breakdown);
 54:     H[j+1+ldh*j] = norm;
 55:     if (*breakdown) {
 56:       *M = j+1;
 57:       *beta = norm;
 58:       return(0);
 59:     } else {
 60:       VecScale(V[j+1],1/norm);
 61:     }
 62:   }
 63:   if (trans) { STApplyTranspose(eps->OP,V[m-1],f); }
 64:   else { STApply(eps->OP,V[m-1],f); }
 65:   IPOrthogonalize(eps->ip,eps->nds,eps->DS,m,PETSC_NULL,V,f,H+ldh*(m-1),beta,PETSC_NULL);
 66:   return(0);
 67: }

 71: /*
 72:    EPSKrylovConvergence - Implements the loop that checks for convergence
 73:    in Krylov methods.

 75:    Input Parameters:
 76:      eps   - the eigensolver; some error estimates are updated in eps->errest 
 77:      issym - whether the projected problem is symmetric or not
 78:      trackall - whether all residuals must be computed
 79:      kini  - initial value of k (the loop variable)
 80:      nits  - number of iterations of the loop
 81:      S     - Schur form of projected matrix (not referenced if issym)
 82:      lds   - leading dimension of S
 83:      Q     - Schur vectors of projected matrix (eigenvectors if issym)
 84:      V     - set of basis vectors (used only if trueresidual is activated)
 85:      nv    - number of vectors to process (dimension of Q, columns of V)
 86:      beta  - norm of f (the residual vector of the Arnoldi/Lanczos factorization)
 87:      corrf - correction factor for residual estimates (only in harmonic KS)

 89:    Output Parameters:
 90:      kout  - the first index where the convergence test failed

 92:    Workspace:
 93:      work is workspace to store 5*nv scalars, nv booleans and nv reals (only if !issym)
 94: */
 95: PetscErrorCode EPSKrylovConvergence(EPS eps,PetscBool issym,PetscBool trackall,PetscInt kini,PetscInt nits,PetscScalar *S,PetscInt lds,PetscScalar *Q,Vec *V,PetscInt nv,PetscReal beta,PetscReal corrf,PetscInt *kout,PetscScalar *work)
 96: {
 98:   PetscInt       k,marker;
 99:   PetscScalar    re,im,*Z = work,*work2 = work;
100:   PetscReal      resnorm;
101:   PetscBool      iscomplex,isshift;

104:   if (!issym) { Z = work; work2 = work+2*nv; }
105:   PetscTypeCompare((PetscObject)eps->OP,STSHIFT,&isshift);
106:   marker = -1;
107:   for (k=kini;k<kini+nits;k++) {
108:     /* eigenvalue */
109:     re = eps->eigr[k];
110:     im = eps->eigi[k];
111:     if (eps->trueres || isshift) {
112:       STBackTransform(eps->OP,1,&re,&im);
113:     }
114:     iscomplex = PETSC_FALSE;
115:     if (!issym && k<nv-1 && S[k+1+k*lds] != 0.0) iscomplex = PETSC_TRUE;
116:     /* residual norm */
117:     if (issym) {
118:       resnorm = beta*PetscAbsScalar(Q[(k-kini+1)*nv-1]);
119:     } else {
120:       DenseSelectedEvec(S,lds,Q,Z,k,iscomplex,nv,work2);
121:       if (iscomplex) resnorm = beta*SlepcAbsEigenvalue(Z[nv-1],Z[2*nv-1]);
122:       else resnorm = beta*PetscAbsScalar(Z[nv-1]);
123:     }
124:     if (eps->trueres) {
125:       if (issym) Z = Q+(k-kini)*nv;
126:       EPSComputeTrueResidual(eps,re,im,Z,V,nv,&resnorm);
127:     }
128:     else resnorm *= corrf;
129:     /* error estimate */
130:     (*eps->conv_func)(eps,re,im,resnorm,&eps->errest[k],eps->conv_ctx);
131:     if (marker==-1 && eps->errest[k] >= eps->tol) marker = k;
132:     if (iscomplex) { eps->errest[k+1] = eps->errest[k]; k++; }
133:     if (marker!=-1 && !trackall) break;
134:   }
135:   if (marker!=-1) k = marker;
136:   *kout = k;
137:   return(0);
138: }

142: /*
143:    EPSFullLanczos - Computes an m-step Lanczos factorization with full
144:    reorthogonalization.  At each Lanczos step, the corresponding Lanczos
145:    vector is orthogonalized with respect to all previous Lanczos vectors.
146:    This is equivalent to computing an m-step Arnoldi factorization and
147:    exploting symmetry of the operator.

149:    The first k columns are assumed to be locked and therefore they are 
150:    not modified. On exit, the following relation is satisfied:

152:                     OP * V - V * T = f * e_m^T

154:    where the columns of V are the Lanczos vectors (which are B-orthonormal),
155:    T is a real symmetric tridiagonal matrix, f is the residual vector and e_m
156:    is the m-th vector of the canonical basis. The tridiagonal is stored as
157:    two arrays: alpha contains the diagonal elements, beta the off-diagonal.
158:    The vector f is B-orthogonal to the columns of V. On exit, the last element
159:    of beta contains the B-norm of f and the next Lanczos vector can be 
160:    computed as v_{m+1} = f / beta(end). 

162: */
163: PetscErrorCode EPSFullLanczos(EPS eps,PetscReal *alpha,PetscReal *beta,Vec *V,PetscInt k,PetscInt *M,Vec f,PetscBool *breakdown)
164: {
166:   PetscInt       j,m = *M;
167:   PetscReal      norm;
168:   PetscScalar    *hwork,lhwork[100];

171:   if (m > 100) {
172:     PetscMalloc((eps->nds+m)*sizeof(PetscScalar),&hwork);
173:   } else {
174:     hwork = lhwork;
175:   }

177:   for (j=k;j<m-1;j++) {
178:     STApply(eps->OP,V[j],V[j+1]);
179:     IPOrthogonalize(eps->ip,eps->nds,eps->DS,j+1,PETSC_NULL,V,V[j+1],hwork,&norm,breakdown);
180:     alpha[j-k] = PetscRealPart(hwork[j]);
181:     beta[j-k] = norm;
182:     if (*breakdown) {
183:       *M = j+1;
184:       if (m > 100) {
185:         PetscFree(hwork);
186:       }
187:       return(0);
188:     } else {
189:       VecScale(V[j+1],1.0/norm);
190:     }
191:   }
192:   STApply(eps->OP,V[m-1],f);
193:   IPOrthogonalize(eps->ip,eps->nds,eps->DS,m,PETSC_NULL,V,f,hwork,&norm,PETSC_NULL);
194:   alpha[m-1-k] = PetscRealPart(hwork[m-1]);
195:   beta[m-1-k] = norm;
196: 
197:   if (m > 100) {
198:     PetscFree(hwork);
199:   }
200:   return(0);
201: }