Actual source code: test25.c

slepc-3.16.3 2022-04-11
Report Typos and Errors
  1: /*
  2:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  3:    SLEPc - Scalable Library for Eigenvalue Problem Computations
  4:    Copyright (c) 2002-2021, Universitat Politecnica de Valencia, Spain

  6:    This file is part of SLEPc.
  7:    SLEPc is distributed under a 2-clause BSD license (see LICENSE).
  8:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  9: */

 11: static char help[] = "Test for DSPEP and DSNEP.\n\n";

 13: #include <slepcds.h>

 15: #define NMAT 5

 17: int main(int argc,char **argv)
 18: {
 20:   DS             ds;
 21:   FN             f[NMAT],qfun;
 22:   SlepcSC        sc;
 23:   PetscScalar    *A,*wr,*wi,*X,*y,*r,numer[NMAT],alpha;
 24:   PetscReal      c[10] = { 0.6, 1.3, 1.3, 0.1, 0.1, 1.2, 1.0, 1.0, 1.2, 1.0 };
 25:   PetscReal      tol,radius=1.5,re,im,nrm;
 26:   PetscInt       i,j,ii,jj,II,k,m=3,n,ld,nev,nfun,d,*inside;
 27:   PetscViewer    viewer;
 28:   PetscBool      verbose,isnep=PETSC_FALSE;
 29:   RG             rg;
 30:   DSMatType      mat[5]={DS_MAT_E0,DS_MAT_E1,DS_MAT_E2,DS_MAT_E3,DS_MAT_E4};
 31: #if !defined(PETSC_USE_COMPLEX)
 32:   PetscScalar    *yi,*ri,alphai=0.0,t;
 33: #endif

 35:   SlepcInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;
 36:   PetscOptionsGetInt(NULL,NULL,"-m",&m,NULL);
 37:   PetscOptionsGetBool(NULL,NULL,"-isnep",&isnep,NULL);
 38:   n = m*m;
 39:   k = 10;
 40:   PetscPrintf(PETSC_COMM_WORLD,"\nButterfly problem, n=%D (m=%D)\n\n",n,m);
 41:   PetscOptionsHasName(NULL,NULL,"-verbose",&verbose);
 42:   PetscOptionsGetReal(NULL,NULL,"-radius",&radius,NULL);

 44:   /* Create DS object */
 45:   DSCreate(PETSC_COMM_WORLD,&ds);
 46:   tol  = 1000*n*PETSC_MACHINE_EPSILON;
 47:   if (isnep) {
 48:     DSSetType(ds,DSNEP);
 49:     DSSetMethod(ds,1);
 50:     DSNEPSetRefine(ds,tol,PETSC_DECIDE);
 51:   } else {
 52:     DSSetType(ds,DSPEP);
 53:   }
 54:   DSSetFromOptions(ds);

 56:   /* Set functions (prior to DSAllocate) f_i=x^i */
 57:   if (isnep) {
 58:     numer[0] = 1.0;
 59:     for (j=1;j<NMAT;j++) numer[j] = 0.0;
 60:     for (i=0;i<NMAT;i++) {
 61:       FNCreate(PETSC_COMM_WORLD,&f[i]);
 62:       FNSetType(f[i],FNRATIONAL);
 63:       FNRationalSetNumerator(f[i],i+1,numer);
 64:     }
 65:     DSNEPSetFN(ds,NMAT,f);
 66:   } else {
 67:     DSPEPSetDegree(ds,NMAT-1);
 68:   }

 70:   /* Set dimensions */
 71:   ld = n+2;  /* test leading dimension larger than n */
 72:   DSAllocate(ds,ld);
 73:   DSSetDimensions(ds,n,0,0);

 75:   /* Set region (used only in method=1) */
 76:   RGCreate(PETSC_COMM_WORLD,&rg);
 77:   RGSetType(rg,RGELLIPSE);
 78:   RGEllipseSetParameters(rg,1.5,radius,.5);
 79:   RGSetFromOptions(rg);
 80:   if (isnep) {
 81:     DSNEPSetRG(ds,rg);
 82:   }

 84:   /* Set up viewer */
 85:   PetscViewerASCIIGetStdout(PETSC_COMM_WORLD,&viewer);
 86:   DSViewFromOptions(ds,NULL,"-ds_view");
 87:   if (verbose) {
 88:     PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);
 89:     /* Show info about functions */
 90:     if (isnep) {
 91:       DSNEPGetNumFN(ds,&nfun);
 92:       for (i=0;i<nfun;i++) {
 93:         PetscPrintf(PETSC_COMM_WORLD,"Function %D:\n",i);
 94:         DSNEPGetFN(ds,i,&qfun);
 95:         FNView(qfun,NULL);
 96:       }
 97:     }
 98:   }

100:   /* Fill matrices */
101:   /* A0 */
102:   DSGetArray(ds,DS_MAT_E0,&A);
103:   for (II=0;II<n;II++) {
104:     i = II/m; j = II-i*m;
105:     A[II+II*ld] = 4.0*c[0]/6.0+4.0*c[1]/6.0;
106:     if (j>0) A[II+(II-1)*ld] = c[0]/6.0;
107:     if (j<m-1) A[II+ld*(II+1)] = c[0]/6.0;
108:     if (i>0) A[II+ld*(II-m)] = c[1]/6.0;
109:     if (i<m-1) A[II+ld*(II+m)] = c[1]/6.0;
110:   }
111:   DSRestoreArray(ds,DS_MAT_E0,&A);

113:   /* A1 */
114:   DSGetArray(ds,DS_MAT_E1,&A);
115:   for (II=0;II<n;II++) {
116:     i = II/m; j = II-i*m;
117:     if (j>0) A[II+ld*(II-1)] = c[2];
118:     if (j<m-1) A[II+ld*(II+1)] = -c[2];
119:     if (i>0) A[II+ld*(II-m)] = c[3];
120:     if (i<m-1) A[II+ld*(II+m)] = -c[3];
121:   }
122:   DSRestoreArray(ds,DS_MAT_E1,&A);

124:   /* A2 */
125:   DSGetArray(ds,DS_MAT_E2,&A);
126:   for (II=0;II<n;II++) {
127:     i = II/m; j = II-i*m;
128:     A[II+ld*II] = -2.0*c[4]-2.0*c[5];
129:     if (j>0) A[II+ld*(II-1)] = c[4];
130:     if (j<m-1) A[II+ld*(II+1)] = c[4];
131:     if (i>0) A[II+ld*(II-m)] = c[5];
132:     if (i<m-1) A[II+ld*(II+m)] = c[5];
133:   }
134:   DSRestoreArray(ds,DS_MAT_E2,&A);

136:   /* A3 */
137:   DSGetArray(ds,DS_MAT_E3,&A);
138:   for (II=0;II<n;II++) {
139:     i = II/m; j = II-i*m;
140:     if (j>0) A[II+ld*(II-1)] = c[6];
141:     if (j<m-1) A[II+ld*(II+1)] = -c[6];
142:     if (i>0) A[II+ld*(II-m)] = c[7];
143:     if (i<m-1) A[II+ld*(II+m)] = -c[7];
144:   }
145:   DSRestoreArray(ds,DS_MAT_E3,&A);

147:   /* A4 */
148:   DSGetArray(ds,DS_MAT_E4,&A);
149:   for (II=0;II<n;II++) {
150:     i = II/m; j = II-i*m;
151:     A[II+ld*II] = 2.0*c[8]+2.0*c[9];
152:     if (j>0) A[II+ld*(II-1)] = -c[8];
153:     if (j<m-1) A[II+ld*(II+1)] = -c[8];
154:     if (i>0) A[II+ld*(II-m)] = -c[9];
155:     if (i<m-1) A[II+ld*(II+m)] = -c[9];
156:   }
157:   DSRestoreArray(ds,DS_MAT_E4,&A);

159:   if (verbose) {
160:     PetscPrintf(PETSC_COMM_WORLD,"Initial - - - - - - - - -\n");
161:     DSView(ds,viewer);
162:   }

164:   /* Solve */
165:   if (isnep) {
166:     DSNEPGetMinimality(ds,&d);
167:   } else {
168:     DSPEPGetDegree(ds,&d);
169:   }
170:   PetscCalloc3(n*d,&wr,n*d,&wi,n*d,&inside);
171:   DSGetSlepcSC(ds,&sc);
172:   sc->comparison    = SlepcCompareLargestMagnitude;
173:   sc->comparisonctx = NULL;
174:   sc->map           = NULL;
175:   sc->mapobj        = NULL;
176:   DSSolve(ds,wr,wi);
177:   DSSort(ds,wr,wi,NULL,NULL,NULL);

179:   if (verbose) {
180:     PetscPrintf(PETSC_COMM_WORLD,"After solve - - - - - - - - -\n");
181:     DSView(ds,viewer);
182:   }
183:   if (isnep) {
184:     DSGetDimensions(ds,NULL,NULL,NULL,&nev);
185:     for (i=0;i<nev;i++) inside[i] = i;
186:   } else {
187:     RGCheckInside(rg,d*n,wr,wi,inside);
188:     nev = 0;
189:     for (i=0;i<d*n;i++) if (inside[i]>0) inside[nev++] = i;
190:   }

192:   /* Print computed eigenvalues */
193:   PetscMalloc2(ld,&y,ld,&r);
194: #if !defined(PETSC_USE_COMPLEX)
195:   PetscMalloc2(ld,&yi,ld,&ri);
196: #endif
197:   DSVectors(ds,DS_MAT_X,NULL,NULL);
198:   DSGetArray(ds,DS_MAT_X,&X);
199:   PetscPrintf(PETSC_COMM_WORLD,"Computed eigenvalues in the region: %D\n",nev);
200:   for (i=0;i<nev;i++) {
201: #if defined(PETSC_USE_COMPLEX)
202:     re = PetscRealPart(wr[inside[i]]);
203:     im = PetscImaginaryPart(wr[inside[i]]);
204: #else
205:     re = wr[inside[i]];
206:     im = wi[inside[i]];
207: #endif
208:     PetscArrayzero(r,n);
209: #if !defined(PETSC_USE_COMPLEX)
210:     PetscArrayzero(ri,n);
211: #endif
212:     /* Residual */
213:     alpha = 1.0;
214:     for (k=0;k<NMAT;k++) {
215:       DSGetArray(ds,mat[k],&A);
216:       for (ii=0;ii<n;ii++) {
217:         y[ii] = 0.0;
218:         for (jj=0;jj<n;jj++) y[ii] += A[jj*ld+ii]*X[inside[i]*ld+jj];
219:       }
220: #if !defined(PETSC_USE_COMPLEX)
221:       for (ii=0;ii<n;ii++) {
222:         yi[ii] = 0.0;
223:         for (jj=0;jj<n;jj++) yi[ii] += A[jj*ld+ii]*X[inside[i+1]*ld+jj];
224:       }
225: #endif
226:       DSRestoreArray(ds,mat[k],&A);
227:       if (isnep) {
228:         FNEvaluateFunction(f[k],wr[inside[i]],&alpha);
229:       }
230:       for (ii=0;ii<n;ii++) r[ii] += alpha*y[ii];
231: #if !defined(PETSC_USE_COMPLEX)
232:       for (ii=0;ii<n;ii++) r[ii]  -= alphai*yi[ii];
233:       for (ii=0;ii<n;ii++) ri[ii] += alpha*yi[ii]+alphai*y[ii];
234: #endif
235:       if (!isnep) {
236: #if defined(PETSC_USE_COMPLEX)
237:         alpha *= wr[inside[i]];
238: #else
239:         t      = alpha;
240:         alpha  = alpha*re-alphai*im;
241:         alphai = alphai*re+t*im;
242: #endif
243:       }
244:     }
245:     nrm = 0.0;
246:     for (k=0;k<n;k++) {
247: #if !defined(PETSC_USE_COMPLEX)
248:       nrm += r[k]*r[k]+ri[k]*ri[k];
249: #else
250:       nrm += PetscRealPart(r[k]*PetscConj(r[k]));
251: #endif
252:     }
253:     nrm = PetscSqrtReal(nrm);
254:     if (nrm/SlepcAbsEigenvalue(wr[inside[i]],wi[inside[i]])>tol) {
255:       PetscPrintf(PETSC_COMM_WORLD,"Warning: the residual norm of the %D-th computed eigenpair %g\n",i,(double)nrm);
256:     }
257:     if (PetscAbs(im)<1e-10) {
258:       PetscViewerASCIIPrintf(viewer,"  %.5f\n",(double)re);
259:     } else {
260:       PetscViewerASCIIPrintf(viewer,"  %.5f%+.5fi\n",(double)re,(double)im);
261:     }
262: #if !defined(PETSC_USE_COMPLEX)
263:     if (im!=0.0) i++;
264:     if (PetscAbs(im)<1e-10) {
265:       PetscViewerASCIIPrintf(viewer,"  %.5f\n",(double)re);
266:     } else {
267:       PetscViewerASCIIPrintf(viewer,"  %.5f%+.5fi\n",(double)re,(double)-im);
268:     }
269: #endif
270:   }
271:   DSRestoreArray(ds,DS_MAT_X,&X);
272:   PetscFree3(wr,wi,inside);
273:   PetscFree2(y,r);
274: #if !defined(PETSC_USE_COMPLEX)
275:   PetscFree2(yi,ri);
276: #endif
277:   if (isnep) {
278:     for (i=0;i<NMAT;i++) {
279:       FNDestroy(&f[i]);
280:     }
281:   }
282:   DSDestroy(&ds);
283:   RGDestroy(&rg);
284:   SlepcFinalize();
285:   return ierr;
286: }

288: /*TEST

290:    testset:
291:       filter: sed -e "s/[+-]\([0-9]\.[0-9]*i\)/+-\\1/" | sed -e "s/56808/56807/" | sed -e "s/34719/34720/"
292:       output_file: output/test25_1.out
293:       test:
294:          suffix: 1
295:       test:
296:          suffix: 2
297:          args: -isnep
298:          requires: complex !single

300: TEST*/