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: }