Date: 2015-09-03T15:05:38+00:00

Actual source code: pepkrylov.c
slepc-3.6.1 2015-09-03
Report Typos and Errors

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

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

      8:    This file is part of SLEPc.

     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 <slepc/private/pepimpl.h>    /*I "slepcpep.h" I*/
     25: #include <slepcblaslapack.h>
     26:  #include pepkrylov.h

     30: PetscErrorCode PEPExtractVectors_TOAR(PEP pep)
     31: {
     33:   PetscInt       i,j,deg=pep->nmat-1,lds,idxcpy=0,ldds,k,ld;
     34:   PetscScalar    *X,*er,*ei,*SS,*vals,*ivals,sone=1.0,szero=0.0,*yi,*yr,*tr,*ti,alpha,t,*S,*pS0;
     35:   PetscBLASInt   k_,lds_,one=1,ldds_;
     36:   PetscBool      flg;
     37:   PetscReal      norm,max;
     38:   Vec            xr,xi,w[4];
     39:   PEP_TOAR       *ctx = (PEP_TOAR*)pep->data;
     40:   Mat            S0;

     43:   S = ctx->S;
     44:   ld = ctx->ld;
     45:   k = pep->nconv;
     46:   if (k==0) return(0);
     47:   lds = deg*ld;
     48:   DSGetLeadingDimension(pep->ds,&ldds);
     49:   PetscMalloc5(k,&er,k,&ei,k*k,&SS,pep->nmat,&vals,pep->nmat,&ivals);
     50:   STGetTransform(pep->st,&flg);
     51:   for (i=0;i<k;i++) {
     52:     er[i] = pep->eigr[i];
     53:     ei[i] = pep->eigi[i];
     54:   }
     55:   if (flg) {
     56:     for (i=0;i<k;i++) {
     57:       er[i] = pep->sfactor*pep->eigr[i];
     58:       ei[i] = pep->sfactor*pep->eigi[i];
     59:     }
     60:   }
     61:   STBackTransform(pep->st,k,er,ei);

     63:   DSVectors(pep->ds,DS_MAT_X,NULL,NULL);
     64:   DSGetArray(pep->ds,DS_MAT_X,&X);

     66:   PetscBLASIntCast(k,&k_);
     67:   PetscBLASIntCast(lds,&lds_);
     68:   PetscBLASIntCast(ldds,&ldds_);

     70:   if (pep->extract==PEP_EXTRACT_NONE || pep->refine==PEP_REFINE_MULTIPLE) {
     71:     PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&k_,&k_,&k_,&sone,S,&lds_,X,&ldds_,&szero,SS,&k_));
     72:   } else {
     73:     switch (pep->extract) {
     74:     case PEP_EXTRACT_NONE:
     75:       break;
     76:     case PEP_EXTRACT_NORM:
     77:       for (i=0;i<k;i++) {
     78:         PEPEvaluateBasis(pep,er[i],ei[i],vals,ivals);
     79:         max = 1.0;
     80:         for (j=1;j<deg;j++) {
     81:           norm = SlepcAbsEigenvalue(vals[j],ivals[j]);
     82:           if (max < norm) { max = norm; idxcpy = j; }
     83:         }
     84:         PetscStackCallBLAS("BLASgemv",BLASgemv_("N",&k_,&k_,&sone,S+idxcpy*ld,&lds_,X+i*ldds,&one,&szero,SS+i*k,&one));
     85: #if !defined(PETSC_USE_COMPLEX)
     86:         if (PetscRealPart(ei[i])!=0.0) {
     87:           i++;
     88:           PetscStackCallBLAS("BLASgemv",BLASgemv_("N",&k_,&k_,&sone,S+idxcpy*ld,&lds_,X+i*ldds,&one,&szero,SS+i*k,&one));
     89:         }
     90: #endif
     91:       }
     92:       break;
     93:     case PEP_EXTRACT_RESIDUAL:
     94:       VecDuplicate(pep->work[0],&xr);
     95:       VecDuplicate(pep->work[0],&w[0]);
     96:       VecDuplicate(pep->work[0],&w[1]);
     97: #if !defined(PETSC_USE_COMPLEX)
     98:       VecDuplicate(pep->work[0],&w[2]);
     99:       VecDuplicate(pep->work[0],&w[3]);
    100:       VecDuplicate(pep->work[0],&xi);
    101: #else
    102:       xi = NULL;
    103: #endif
    104:       for (i=0;i<k;i++) {
    105:         max = 0.0;
    106:         for (j=0;j<deg;j++) {
    107:           PetscStackCallBLAS("BLASgemv",BLASgemv_("N",&k_,&k_,&sone,S+j*ld,&lds_,X+i*ldds,&one,&szero,SS+i*k,&one));
    108:           BVMultVec(pep->V,1.0,0.0,xr,SS+i*k);
    109: #if !defined(PETSC_USE_COMPLEX)
    110:           PetscStackCallBLAS("BLASgemv",BLASgemv_("N",&k_,&k_,&sone,S+j*ld,&lds_,X+(i+1)*ldds,&one,&szero,SS+i*k,&one));
    111:           BVMultVec(pep->V,1.0,0.0,xi,SS+i*k);
    112: #endif
    113:           PEPComputeResidualNorm_Private(pep,er[i],ei[i],xr,xi,w,&norm);
    114:           if (norm>max) { max = norm; idxcpy=j; }
    115:         }
    116:         PetscStackCallBLAS("BLASgemv",BLASgemv_("N",&k_,&k_,&sone,S+idxcpy*ld,&lds_,X+i*ldds,&one,&szero,SS+i*k,&one));
    117: #if !defined(PETSC_USE_COMPLEX)
    118:         if (PetscRealPart(ei[i])!=0.0) {
    119:           i++;
    120:           PetscStackCallBLAS("BLASgemv",BLASgemv_("N",&k_,&k_,&sone,S+idxcpy*ld,&lds_,X+i*ldds,&one,&szero,SS+i*k,&one));
    121:         }
    122: #endif
    123:       }
    124:       VecDestroy(&xr);
    125:       VecDestroy(&w[0]);
    126:       VecDestroy(&w[1]);
    127: #if !defined(PETSC_USE_COMPLEX)
    128:       VecDestroy(&w[2]);
    129:       VecDestroy(&w[3]);
    130:       VecDestroy(&xi);
    131: #endif
    132:       break;
    133:     case PEP_EXTRACT_STRUCTURED:
    134:       PetscMalloc2(k,&tr,k,&ti);
    135:       for (i=0;i<k;i++) {
    136:         PetscMemzero(SS+i*k,k*sizeof(PetscScalar));
    137: #if !defined(PETSC_USE_COMPLEX)
    138:         if (ei[i]!=0.0) {
    139:           PetscMemzero(SS+(i+1)*k,k*sizeof(PetscScalar));
    140:         }
    141: #endif
    142:         t = 0.0;
    143:         PEPEvaluateBasis(pep,er[i],ei[i],vals,ivals);
    144:         yr = X+i*ldds; yi = NULL;
    145:         for (j=0;j<deg;j++) {
    146:           alpha = PetscConj(vals[j]);
    147: #if !defined(PETSC_USE_COMPLEX)
    148:           if (ei[i]!=0.0) {
    149:             PetscMemzero(tr,k*sizeof(PetscScalar));
    150:             PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&k_,&vals[j],X+i*ldds,&one,tr,&one));
    151:             PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&k_,&ivals[j],X+(i+1)*ldds,&one,tr,&one));
    152:             yr = tr;
    153:             PetscMemzero(ti,k*sizeof(PetscScalar));
    154:             PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&k_,&vals[j],X+(i+1)*ldds,&one,ti,&one));
    155:             alpha = -ivals[j];
    156:             PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&k_,&alpha,X+i*ldds,&one,ti,&one));
    157:             yi = ti;
    158:             alpha = 1.0;
    159:           } else { yr = X+i*ldds; yi = NULL;}
    160: #endif
    161:           PetscStackCallBLAS("BLASgemv",BLASgemv_("N",&k_,&k_,&alpha,S+j*ld,&lds_,yr,&one,&sone,SS+i*k,&one));
    162:           t += SlepcAbsEigenvalue(vals[j],ivals[j])*SlepcAbsEigenvalue(vals[j],ivals[j]);
    163:           if (yi) {
    164:             PetscStackCallBLAS("BLASgemv",BLASgemv_("N",&k_,&k_,&alpha,S+j*ld,&lds_,yi,&one,&sone,SS+(i+1)*k,&one));
    165:           }
    166:         }
    167:         t = 1.0/t;
    168:         PetscStackCallBLAS("BLASscal",BLASscal_(&k_,&t,SS+i*k,&one));
    169:         if (yi) {
    170:           PetscStackCallBLAS("BLASscal",BLASscal_(&k_,&t,SS+(i+1)*k,&one));
    171:           i++;
    172:         }
    173:       }
    174:       PetscFree2(tr,ti);
    175:       break;
    176:     default:
    177:         SETERRQ(PetscObjectComm((PetscObject)pep),PETSC_ERR_SUP,"Extraction not implemented in this solver");
    178:     }
    179:   }

    181:   /* update vectors V = V*S */
    182:   MatCreateSeqDense(PETSC_COMM_SELF,k,k,NULL,&S0);
    183:   MatDenseGetArray(S0,&pS0);
    184:   for (i=0;i<k;i++) {
    185:     PetscMemcpy(pS0+i*k,SS+i*k,k*sizeof(PetscScalar));
    186:   }
    187:   MatDenseRestoreArray(S0,&pS0);
    188:   BVSetActiveColumns(pep->V,0,k);
    189:   BVMultInPlace(pep->V,S0,0,k);
    190:   MatDestroy(&S0);
    191:   BVSetActiveColumns(pep->V,0,k);
    192:   PetscFree5(er,ei,SS,vals,ivals);
    193:   return(0);
    194: }

    198: PetscErrorCode PEPReset_TOAR(PEP pep)
    199: {
    200:   PEP_TOAR       *ctx = (PEP_TOAR*)pep->data;

    204:   PetscFree(ctx->S);
    205:   PetscFree(ctx->qB);
    206:   return(0);
    207: }