Date: 2013-09-02T10:04:15+00:00

Actual source code: dvd_gd2.c

      1: /*
      2:   SLEPc eigensolver: "davidson"

      4:   Step: improve the eigenvectors X with GD2

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

     10:    This file is part of SLEPc.

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

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

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

     26:  #include davidson.h
     27: #include <slepc-private/vecimplslepc.h>         /*I "slepcvec.h" I*/

     29: PetscErrorCode dvd_improvex_gd2_d(dvdDashboard *d);
     30: PetscErrorCode dvd_improvex_gd2_gen(dvdDashboard *d,Vec *D,PetscInt max_size_D,PetscInt r_s,PetscInt r_e,PetscInt *size_D);
     31: PetscErrorCode dvd_improvex_get_eigenvectors(dvdDashboard *d,PetscScalar *pX,PetscScalar *pY,PetscInt ld_,PetscScalar *auxS,PetscInt size_auxS);

     33: #define size_Z (64*4)

     35: /**** GD2 update step K*[A*X B*X]  ****/

     37: typedef struct {
     38:   PetscInt size_X;
     39:   void         *old_improveX_data;   /* old improveX_data */
     40:   improveX_type old_improveX;        /* old improveX */
     41: } dvdImprovex_gd2;

     45: PetscErrorCode dvd_improvex_gd2(dvdDashboard *d,dvdBlackboard *b,KSP ksp,PetscInt max_bs)
     46: {
     47:   PetscErrorCode  ierr;
     48:   dvdImprovex_gd2 *data;
     49:   PetscBool       her_probl,std_probl;
     50:   PC              pc;
     51:   PetscInt        s=1;

     54:   std_probl = DVD_IS(d->sEP, DVD_EP_STD)?PETSC_TRUE:PETSC_FALSE;
     55:   her_probl = DVD_IS(d->sEP, DVD_EP_HERMITIAN)?PETSC_TRUE:PETSC_FALSE;

     57:   /* Setting configuration constrains */
     58:   /* If the arithmetic is real and the problem is not Hermitian, then
     59:      the block size is incremented in one */
     60: #if !defined(PETSC_USE_COMPLEX)
     61:   if (!her_probl) {
     62:     max_bs++;
     63:     b->max_size_P = PetscMax(b->max_size_P, 2);
     64:     s = 2;
     65:   } else
     66: #endif
     67:     b->max_size_P = PetscMax(b->max_size_P, 1);
     68:   b->max_size_X = PetscMax(b->max_size_X, max_bs);
     69:   b->max_size_auxV = PetscMax(b->max_size_auxV,
     70:      s +
     71:      ((her_probl || !d->eps->trueres)?1:PetscMax(s*2,b->max_size_cX_proj+b->max_size_X))); /* testConv */

     73:   b->max_size_auxS = PetscMax(b->max_size_auxS,
     74:       (her_probl || !d->eps->trueres)?0:b->max_nev*b->max_nev+PetscMax(b->max_nev*6,(b->max_nev+b->max_size_proj)*s+b->max_nev*(b->max_size_X+b->max_size_cX_proj)*(std_probl?2:4)+64)); /* preTestConv */

     76:   /* Setup the preconditioner */
     77:   if (ksp) {
     78:     KSPGetPC(ksp,&pc);
     79:     dvd_static_precond_PC(d,b,pc);
     80:   } else {
     81:     dvd_static_precond_PC(d,b,0);
     82:   }

     84:   /* Setup the step */
     85:   if (b->state >= DVD_STATE_CONF) {
     86:     PetscMalloc(sizeof(dvdImprovex_gd2),&data);
     87:     PetscLogObjectMemory(d->eps,sizeof(dvdImprovex_gd2));
     88:     data->old_improveX_data = d->improveX_data;
     89:     d->improveX_data = data;
     90:     data->old_improveX = d->improveX;
     91:     data->size_X = b->max_size_X;
     92:     d->improveX = dvd_improvex_gd2_gen;

     94:     DVD_FL_ADD(d->destroyList,dvd_improvex_gd2_d);
     95:   }
     96:   return(0);
     97: }

    101: PetscErrorCode dvd_improvex_gd2_d(dvdDashboard *d)
    102: {
    103:   PetscErrorCode  ierr;
    104:   dvdImprovex_gd2 *data = (dvdImprovex_gd2*)d->improveX_data;

    107:   /* Restore changes in dvdDashboard */
    108:   d->improveX_data = data->old_improveX_data;

    110:   /* Free local data and objects */
    111:   PetscFree(data);
    112:   return(0);
    113: }

    115: #define DVD_COMPLEX_RAYLEIGH_QUOTIENT(ur,ui,Axr,Axi,Bxr,Bxi,eigr,eigi,b,ierr)\
    116: { \
    117:   VecDot((Axr), (ur), &(b)[0]); /* r*A*r */ \
    118:   VecDot((Axr), (ui), &(b)[1]); /* i*A*r */ \
    119:   VecDot((Axi), (ur), &(b)[2]); /* r*A*i */ \
    120:   VecDot((Axi), (ui), &(b)[3]); /* i*A*i */ \
    121:   VecDot((Bxr), (ur), &(b)[4]); /* r*B*r */ \
    122:   VecDot((Bxr), (ui), &(b)[5]); /* i*B*r */ \
    123:   VecDot((Bxi), (ur), &(b)[6]); /* r*B*i */ \
    124:   VecDot((Bxi), (ui), &(b)[7]); /* i*B*i */ \
    125:   (b)[0]  = (b)[0]+(b)[3]; /* rAr+iAi */ \
    126:   (b)[2] =  (b)[2]-(b)[1]; /* rAi-iAr */ \
    127:   (b)[4] = (b)[4]+(b)[7]; /* rBr+iBi */ \
    128:   (b)[6] = (b)[6]-(b)[5]; /* rBi-iBr */ \
    129:   (b)[7] = (b)[4]*(b)[4] + (b)[6]*(b)[6]; /* k */ \
    130:   *(eigr) = ((b)[0]*(b)[4] + (b)[2]*(b)[6]) / (b)[7]; /* eig_r */ \
    131:   *(eigi) = ((b)[2]*(b)[4] - (b)[0]*(b)[6]) / (b)[7]; /* eig_i */ \
    132: }

    134: #if !defined(PETSC_USE_COMPLEX)
    135: #define DVD_COMPUTE_N_RR(eps,i,i_s,n,eigr,eigi,u,Ax,Bx,b,ierr) \
    136:   for ((i)=0; (i)<(n); (i)++) { \
    137:     if ((eigi)[(i_s)+(i)] != 0.0) { \
    138:       /* eig_r = [(rAr+iAi)*(rBr+iBi) + (rAi-iAr)*(rBi-iBr)]/k \
    139:          eig_i = [(rAi-iAr)*(rBr+iBi) - (rAr+iAi)*(rBi-iBr)]/k \
    140:          k     =  (rBr+iBi)*(rBr+iBi) + (rBi-iBr)*(rBi-iBr)    */ \
    141:       DVD_COMPLEX_RAYLEIGH_QUOTIENT((u)[(i)], (u)[(i)+1], (Ax)[(i)], \
    142:         (Ax)[(i)+1], (Bx)[(i)], (Bx)[(i)+1], &(b)[8], &(b)[9], (b), (ierr)); \
    143:       if (PetscAbsScalar((eigr)[(i_s)+(i)] - (b)[8])/ \
    144:             PetscAbsScalar((eigr)[(i_s)+(i)]) > 1e-10    || \
    145:           PetscAbsScalar((eigi)[(i_s)+(i)] - (b)[9])/ \
    146:             PetscAbsScalar((eigi)[(i_s)+(i)]) > 1e-10) { \
    147:         (ierr) = PetscInfo4((eps), "The eigenvalue %G+%G is far from its "\
    148:                             "Rayleigh quotient value %G+%G\n", \
    149:                             (eigr)[(i_s)+(i)], \
    150:                             (eigi)[(i_s)+1], (b)[8], (b)[9]); \
    151:       } \
    152:       (i)++; \
    153:     } else { \
    154:       (ierr) = VecDot((Ax)[(i)], (u)[(i)], &(b)[0]); \
    155:       (ierr) = VecDot((Bx)[(i)], (u)[(i)], &(b)[1]); \
    156:       (b)[0] = (b)[0]/(b)[1]; \
    157:       if (PetscAbsScalar((eigr)[(i_s)+(i)] - (b)[0])/ \
    158:             PetscAbsScalar((eigr)[(i_s)+(i)]) > 1e-10) { \
    159:         (ierr) = PetscInfo3((eps), "The eigenvalue %G is far from its " \
    160:                "Rayleigh quotient value %G. (y'*B*x = %G)\n", \
    161:                (eigr)[(i_s)+(i)], \
    162:                (b)[0], (b)[1]); \
    163:       } \
    164:     } \
    165:   }
    166: #else
    167: #define DVD_COMPUTE_N_RR(eps,i,i_s,n,eigr,eigi,u,Ax,Bx,b,ierr) \
    168:   for ((i)=0; (i)<(n); (i)++) { \
    169:       (ierr) = VecDot((Ax)[(i)], (u)[(i)], &(b)[0]); \
    170:       (ierr) = VecDot((Bx)[(i)], (u)[(i)], &(b)[1]); \
    171:       (b)[0] = (b)[0]/(b)[1]; \
    172:       if (PetscAbsScalar((eigr)[(i_s)+(i)] - (b)[0])/ \
    173:             PetscAbsScalar((eigr)[(i_s)+(i)]) > 1e-10) { \
    174:         (ierr) = PetscInfo4((eps), "The eigenvalue %G+%G is far from its " \
    175:                "Rayleigh quotient value %G+%G\n", \
    176:                PetscRealPart((eigr)[(i_s)+(i)]), \
    177:                PetscImaginaryPart((eigr)[(i_s)+(i)]), PetscRealPart((b)[0]), \
    178:                PetscImaginaryPart((b)[0])); \
    179:       } \
    180:     }
    181: #endif

    185: PetscErrorCode dvd_improvex_gd2_gen(dvdDashboard *d,Vec *D,PetscInt max_size_D,PetscInt r_s,PetscInt r_e,PetscInt *size_D)
    186: {
    187:   dvdImprovex_gd2 *data = (dvdImprovex_gd2*)d->improveX_data;
    188:   PetscErrorCode  ierr;
    189:   PetscInt        i,j,n,s,ld,k;
    190:   PetscScalar     *pX,*pY,b[10],Z[size_Z];
    191:   Vec             *Ax,*Bx,X[4];

    194:   /* Compute the number of pairs to improve */
    195:   n = PetscMin(PetscMin(PetscMin(data->size_X*2,max_size_D),(r_e-r_s)*2),d->max_size_proj-d->size_H)/2;
    196: #if !defined(PETSC_USE_COMPLEX)
    197:   /* If the last eigenvalue is a complex conjugate pair, n is increased by one */
    198:   for (i=0; i<n; i++) {
    199:     if (d->eigi[i] != 0.0) i++;
    200:   }
    201:   if (i > n) {
    202:     n = PetscMin(PetscMin(PetscMin(data->size_X*2,max_size_D),(n+1)*2),d->max_size_proj-d->size_H)/2;
    203:     if (i > n) n--;
    204:   }
    205: #endif

    207:   /* Quick exit */
    208:   if (max_size_D == 0 || r_e-r_s <= 0 || n == 0) {
    209:    *size_D = 0;
    210:    /* Callback old improveX */
    211:     if (data->old_improveX) {
    212:       d->improveX_data = data->old_improveX_data;
    213:       data->old_improveX(d,NULL,0,0,0,NULL);
    214:       d->improveX_data = data;
    215:     }
    216:     return(0);
    217:   }

    219:   /* Compute the eigenvectors of the selected pairs */
    220:   for (i=0;i<n;) {
    221:     k = r_s+i+d->cX_in_H;
    222:     DSVectors(d->ps,DS_MAT_X,&k,NULL);
    223:     DSNormalize(d->ps,DS_MAT_X,r_s+i+d->cX_in_H);
    224:     k = r_s+i+d->cX_in_H;
    225:     DSVectors(d->ps,DS_MAT_Y,&k,NULL);
    226:     DSNormalize(d->ps,DS_MAT_Y,r_s+i+d->cX_in_H);
    227:     /* Jump complex conjugate pairs */
    228:     i = k+1;
    229:   }
    230:   DSGetArray(d->ps,DS_MAT_X,&pX);
    231:   DSGetArray(d->ps,DS_MAT_Y,&pY);
    232:   DSGetLeadingDimension(d->ps,&ld);

    234:   /* Bx <- B*X(i) */
    235:   Bx = D+n;
    236:   if (d->BV) {
    237:     /* Compute the norms of the eigenvectors */
    238:     if (d->correctXnorm) {
    239:       dvd_improvex_compute_X(d,r_s,r_s+n,Bx,pX,ld);
    240:     } else {
    241:       for (i=0; i<n; i++) d->nX[r_s+i] = 1.0;
    242:     }
    243:     SlepcUpdateVectorsZ(Bx,0.0,1.0,d->BV-d->cX_in_H,d->size_BV+d->cX_in_H,&pX[ld*r_s],ld,d->size_H,n);
    244:   } else if (d->B) {
    245:     for (i=0;i<n;i++) {
    246:       /* auxV(0) <- X(i) */
    247:       dvd_improvex_compute_X(d,r_s+i,r_s+i+1,d->auxV,pX,ld);
    248:       /* Bx(i) <- B*auxV(0) */
    249:       MatMult(d->B,d->auxV[0],Bx[i]);
    250:     }
    251:   } else {
    252:     /* Bx <- X */
    253:     dvd_improvex_compute_X(d,r_s,r_s+n,Bx,pX,ld);
    254:   }

    256:   /* Ax <- A*X(i) */
    257:   Ax = D;
    258:   SlepcUpdateVectorsZ(Ax,0.0,1.0,d->AV-d->cX_in_H,d->size_AV+d->cX_in_H,&pX[ld*r_s],ld,d->size_H,n);

    260: #if !defined(PETSC_USE_COMPLEX)
    261:   s = d->eigi[r_s] == 0.0 ? 1 : 2;
    262:   /* If the available vectors allow the computation of the eigenvalue */
    263:   if (s <= n) {
    264: #else
    265:   s = 1;
    266: #endif
    267:   /* v <- Y(i) */
    268:   SlepcUpdateVectorsZ(d->auxV,0.0,1.0,(d->W?d->W:d->V)-d->cX_in_H,d->size_V+d->cX_in_H,&pY[ld*r_s],ld,d->size_H,s);

    270:   /* Recompute the eigenvalue */
    271:   DVD_COMPUTE_N_RR(d->eps,i,r_s,1,d->eigr,d->eigi,d->auxV,Ax,Bx,b,ierr);
    272: #if !defined(PETSC_USE_COMPLEX)
    273:   }
    274: #endif

    276:   DSRestoreArray(d->ps,DS_MAT_X,&pX);
    277:   DSRestoreArray(d->ps,DS_MAT_Y,&pY);

    279:   for (i=0,s=0;i<n;i+=s) {
    280: #if !defined(PETSC_USE_COMPLEX)
    281:     if (d->eigi[r_s+i] != 0.0) {
    282:        /* [Ax_i Ax_i+1 Bx_i Bx_i+1]*= [   1        0
    283:                                           0        1
    284:                                        -eigr_i -eigi_i
    285:                                         eigi_i -eigr_i] */
    286:       b[0] = b[5] = 1.0/d->nX[r_s+i];
    287:       b[2] = b[7] = -d->eigr[r_s+i]/d->nX[r_s+i];
    288:       b[6] = -(b[3] = d->eigi[r_s+i]/d->nX[r_s+i]);
    289:       b[1] = b[4] = 0.0;
    290:       X[0] = Ax[i]; X[1] = Ax[i+1]; X[2] = Bx[i]; X[3] = Bx[i+1];
    291:       SlepcUpdateVectorsD(X,4,1.0,b,4,4,2,Z,size_Z);
    292:       s = 2;
    293:     } else
    294: #endif
    295:     {
    296:       /* [Ax_i Bx_i]*= [ 1/nX_i    conj(eig_i/nX_i)
    297:                        -eig_i/nX_i     1/nX_i       ] */
    298:       b[0] = 1.0/d->nX[r_s+i];
    299:       b[1] = -d->eigr[r_s+i]/d->nX[r_s+i];
    300:       b[2] = PetscConj(d->eigr[r_s+i]/d->nX[r_s+i]);
    301:       b[3] = 1.0/d->nX[r_s+i];
    302:       X[0] = Ax[i]; X[1] = Bx[i];
    303:       SlepcUpdateVectorsD(X,2,1.0,b,2,2,2,Z,size_Z);
    304:       s = 1;
    305:     }
    306:     for (j=0; j<s; j++) d->nX[r_s+i+j] = 1.0;

    308:     /* Ax = R <- P*(Ax - eig_i*Bx) */
    309:     d->calcpairs_proj_res(d,r_s+i,r_s+i+s,&Ax[i]);

    311:     /* Check if the first eigenpairs are converged */
    312:     if (i == 0) {
    313:       d->preTestConv(d,0,s,s,Ax,NULL,&d->npreconv);
    314:       if (d->npreconv > 0) break;
    315:     }
    316:   }

    318:   /* D <- K*[Ax Bx] */
    319:   if (d->npreconv == 0) {
    320:     VecCopy(D[0],d->auxV[0]);
    321:     for (i=0;i<2*n-1;i++) {
    322:       d->improvex_precond(d,r_s+(i+1)%n,D[i+1],D[i]);
    323:     }
    324:     d->improvex_precond(d,r_s,d->auxV[0],D[2*n-1]);
    325:     *size_D = 2*n;
    326: #if !defined(PETSC_USE_COMPLEX)
    327:     if (d->eigi[r_s] != 0.0) {
    328:       s = 4;
    329:     } else
    330: #endif
    331:     s = 2;
    332:     /* Prevent that short vectors are discarded in the orthogonalization */
    333:     if (d->eps->errest[d->nconv+r_s] > PETSC_MACHINE_EPSILON && d->eps->errest[d->nconv+r_s] < PETSC_MAX_REAL) {
    334:       for (i=0; i<s && i<*size_D; i++) {
    335:         VecScale(D[i],1.0/d->eps->errest[d->nconv+r_s]);
    336:       }
    337:     }
    338:   } else {
    339:     *size_D = 0;
    340:   }

    342:   /* Callback old improveX */
    343:   if (data->old_improveX) {
    344:     d->improveX_data = data->old_improveX_data;
    345:     data->old_improveX(d,NULL,0,0,0,NULL);
    346:     d->improveX_data = data;
    347:   }
    348:   return(0);
    349: }