Date: 2013-09-02T10:03:37+00:00

Actual source code: ks-indef.c

      1: /*

      3:    SLEPc eigensolver: "krylovschur"

      5:    Method: Krylov-Schur for symmetric-indefinite eigenproblems

      7:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      8:    SLEPc - Scalable Library for Eigenvalue Problem Computations
      9:    Copyright (c) 2002-2013, Universitat Politecnica de Valencia, Spain

     11:    This file is part of SLEPc.

     13:    SLEPc is free software: you can redistribute it and/or modify it under  the
     14:    terms of version 3 of the GNU Lesser General Public License as published by
     15:    the Free Software Foundation.

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

     22:    You  should have received a copy of the GNU Lesser General  Public  License
     23:    along with SLEPc. If not, see <http://www.gnu.org/licenses/>.
     24:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     25: */
     26: #include <slepc-private/epsimpl.h>                /*I "slepceps.h" I*/
     27: #include <slepcblaslapack.h>
     28:  #include krylovschur.h

     32: static PetscErrorCode EPSFullLanczosIndef(EPS eps,PetscReal *alpha,PetscReal *beta,PetscReal *omega,Vec *V,PetscInt k,PetscInt *M,Vec f,PetscBool *breakdown,PetscReal *cos,Vec w)
     33: {
     35:   PetscInt       j,m = *M;
     36:   PetscScalar    *hwork,lhwork[100];
     37:   PetscReal      norm,norm1,norm2,t;

     40:   if (cos) *cos=1.0;
     41:   if (m > 100) {
     42:     PetscMalloc((eps->nds+m)*sizeof(PetscScalar),&hwork);
     43:   } else hwork = lhwork;

     45:   for (j=k;j<m-1;j++) {
     46:     STApply(eps->st,V[j],V[j+1]);
     47:     IPPseudoOrthogonalize(eps->ip,j+1,V,omega,V[j+1],hwork,&norm,breakdown);
     48:     VecScale(V[j+1],1.0/norm);
     49:     alpha[j] = PetscRealPart(hwork[j]);
     50:     beta[j] = PetscAbsReal(norm);
     51:     omega[j+1] = (norm<0.0)?-1.0:1.0;
     52:     /* */
     53:     VecNorm(V[j+1],NORM_2,&norm1);
     54:     IPApplyMatrix(eps->ip,V[j+1],w);
     55:     VecNorm(w,NORM_2,&norm2);
     56:     t=1/(norm1*norm2);
     57:     if (cos && *cos>t) *cos = t;
     58:   }
     59:   STApply(eps->st,V[m-1],f);
     60:   IPPseudoOrthogonalize(eps->ip,m,V,omega,f,hwork,&norm,NULL);
     61:   VecScale(f,1.0/norm);
     62:   alpha[m-1] = PetscRealPart(hwork[m-1]);
     63:   beta[m-1] =PetscAbsReal(norm);
     64:   omega[m] = (norm<0.0)?-1:1;
     65:   if (m > 100) {
     66:     PetscFree(hwork);
     67:   }
     68:   return(0);
     69: }

     73: PetscErrorCode EPSSolve_KrylovSchur_Indefinite(EPS eps)
     74: {
     75:   PetscErrorCode  ierr;
     76:   EPS_KRYLOVSCHUR *ctx = (EPS_KRYLOVSCHUR*)eps->data;
     77:   PetscInt        i,k,l,ld,nv,t;
     78:   Vec             u=eps->work[0],w=eps->work[1];
     79:   PetscScalar     *Q;
     80:   PetscReal       *a,*b,*r,beta,beta1,beta2,norm,*omega;
     81:   PetscBool       breakdown=PETSC_FALSE;

     84:   DSGetLeadingDimension(eps->ds,&ld);

     86:   /* Get the starting Lanczos vector */
     87:   SlepcVecSetRandom(eps->V[0],eps->rand);
     88:   IPNorm(eps->ip,eps->V[0],&norm);
     89:   if (norm==0.0) SETERRQ(PetscObjectComm((PetscObject)eps),1,"Initial vector is zero or belongs to the deflation space");
     90:   DSGetArrayReal(eps->ds,DS_MAT_D,&omega);
     91:   omega[0] = (norm > 0)?1.0:-1.0;
     92:   beta = PetscAbsReal(norm);
     93:   DSRestoreArrayReal(eps->ds,DS_MAT_D,&omega);
     94:   VecScale(eps->V[0],1.0/norm);
     95:   l = 0;

     97:   /* Restart loop */
     98:   while (eps->reason == EPS_CONVERGED_ITERATING) {
     99:     eps->its++;

    101:     /* Compute an nv-step Lanczos factorization */
    102:     nv = PetscMin(eps->nconv+eps->mpd,eps->ncv);
    103:     DSGetArrayReal(eps->ds,DS_MAT_T,&a);
    104:     b = a + ld;
    105:     DSGetArrayReal(eps->ds,DS_MAT_D,&omega);
    106:     EPSFullLanczosIndef(eps,a,b,omega,eps->V,eps->nconv+l,&nv,u,&breakdown,NULL,w);
    107:     beta = b[nv-1];
    108:     DSRestoreArrayReal(eps->ds,DS_MAT_T,&a);
    109:     DSRestoreArrayReal(eps->ds,DS_MAT_D,&omega);
    110:     DSSetDimensions(eps->ds,nv,0,eps->nconv,eps->nconv+l);
    111:     if (l==0) {
    112:       DSSetState(eps->ds,DS_STATE_INTERMEDIATE);
    113:     } else {
    114:       DSSetState(eps->ds,DS_STATE_RAW);
    115:     }
    116:     /* Solve projected problem */
    117:     DSSolve(eps->ds,eps->eigr,eps->eigi);
    118:     DSSort(eps->ds,eps->eigr,eps->eigi,NULL,NULL,NULL);

    120:     /* Check convergence */
    121:     DSGetDimensions(eps->ds,NULL,NULL,NULL,NULL,&t);
    122:     VecNorm(u,NORM_2,&beta1);
    123:     IPApplyMatrix(eps->ip,u,w);
    124:     VecNorm(w,NORM_2,&beta2);
    125:     beta1 = PetscMax(beta1,beta2);
    126:     EPSKrylovConvergence(eps,PETSC_FALSE,eps->nconv,t-eps->nconv,eps->V,nv,beta*beta1,1.0,&k);
    127:     if (eps->its >= eps->max_it) eps->reason = EPS_DIVERGED_ITS;
    128:     if (k >= eps->nev) eps->reason = EPS_CONVERGED_TOL;

    130:     /* Update l */
    131:     if (eps->reason != EPS_CONVERGED_ITERATING || breakdown) l = 0;
    132:     else {
    133:       l = PetscMax(1,(PetscInt)((nv-k)*ctx->keep));
    134:       l = PetscMin(l,t);
    135:       DSGetArrayReal(eps->ds,DS_MAT_T,&a);
    136:       if (*(a+ld+k+l-1)!=0) {
    137:         if (k+l<t-1) l = l+1;
    138:         else l = l-1;
    139:       }
    140:       DSRestoreArrayReal(eps->ds,DS_MAT_T,&a);
    141:     }

    143:     if (eps->reason == EPS_CONVERGED_ITERATING) {
    144:       if (breakdown) {
    145:         SETERRQ1(PetscObjectComm((PetscObject)eps),PETSC_ERR_CONV_FAILED,"Breakdown in Indefinite Krylov-Schur (beta=%g)",beta);
    146:       } else {
    147:         /* Prepare the Rayleigh quotient for restart */
    148:         DSGetArray(eps->ds,DS_MAT_Q,&Q);
    149:         DSGetArrayReal(eps->ds,DS_MAT_T,&a);
    150:         DSGetArrayReal(eps->ds,DS_MAT_D,&omega);
    151:         b = a + ld;
    152:         r = a + 2*ld;
    153:         for (i=k;i<k+l;i++) {
    154:           r[i] = PetscRealPart(Q[nv-1+i*ld]*beta);
    155:         }
    156:         b[k+l-1] = r[k+l-1];
    157:         omega[k+l] = omega[nv];
    158:         DSRestoreArrayReal(eps->ds,DS_MAT_T,&a);
    159:         DSRestoreArray(eps->ds,DS_MAT_Q,&Q);
    160:         DSRestoreArrayReal(eps->ds,DS_MAT_D,&omega);
    161:       }
    162:     }
    163:     /* Update the corresponding vectors V(:,idx) = V*Q(:,idx) */
    164:     DSGetArray(eps->ds,DS_MAT_Q,&Q);
    165:     SlepcUpdateVectors(nv,eps->V,eps->nconv,k+l,Q,ld,PETSC_FALSE);
    166:     DSRestoreArray(eps->ds,DS_MAT_Q,&Q);

    168:     /* Append u to V */
    169:     if (eps->reason == EPS_CONVERGED_ITERATING && !breakdown) {
    170:       VecCopy(u,eps->V[k+l]);
    171:     }

    173:     EPSMonitor(eps,eps->its,k,eps->eigr,eps->eigi,eps->errest,nv);
    174:     eps->nconv = k;
    175:   }
    176:   DSSetDimensions(eps->ds,eps->nconv,0,0,0);
    177:   DSSetState(eps->ds,DS_STATE_RAW);
    178:   return(0);
    179: }