Actual source code: test25.c
slepc-3.16.0 2021-09-30
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*/