Actual source code: snesnoise.c
1: #define PETSCSNES_DLL
3: #include include/private/snesimpl.h
5: /* Data used by Jorge's diff parameter computation method */
6: typedef struct {
7: Vec *workv; /* work vectors */
8: FILE *fp; /* output file */
9: int function_count; /* count of function evaluations for diff param estimation */
10: double fnoise_min; /* minimim allowable noise */
11: double hopt_min; /* minimum allowable hopt */
12: double h_first_try; /* first try for h used in diff parameter estimate */
13: PetscInt fnoise_resets; /* number of times we've reset the noise estimate */
14: PetscInt hopt_resets; /* number of times we've reset the hopt estimate */
15: } DIFFPAR_MORE;
19: EXTERN PetscErrorCode JacMatMultCompare(SNES,Vec,Vec,double);
20: EXTERN PetscErrorCode SNESDefaultMatrixFreeSetParameters2(Mat,double,double,double);
21: EXTERN PetscErrorCode SNESUnSetMatrixFreeParameter(SNES snes);
25: PetscErrorCode DiffParameterCreate_More(SNES snes,Vec x,void **outneP)
26: {
27: DIFFPAR_MORE *neP;
28: Vec w;
29: PetscRandom rctx; /* random number generator context */
31: PetscTruth flg;
32: char noise_file[PETSC_MAX_PATH_LEN];
36: PetscNew(DIFFPAR_MORE,&neP);
37: PetscLogObjectMemory(snes,sizeof(DIFFPAR_MORE));
38:
39: neP->function_count = 0;
40: neP->fnoise_min = 1.0e-20;
41: neP->hopt_min = 1.0e-8;
42: neP->h_first_try = 1.0e-3;
43: neP->fnoise_resets = 0;
44: neP->hopt_resets = 0;
46: /* Create work vectors */
47: VecDuplicateVecs(x,3,&neP->workv);
48: w = neP->workv[0];
50: /* Set components of vector w to random numbers */
51: PetscRandomCreate(snes->comm,&rctx);
52: PetscRandomSetFromOptions(rctx);
53: VecSetRandom(w,rctx);
54: PetscRandomDestroy(rctx);
56: /* Open output file */
57: PetscOptionsGetString(snes->prefix,"-snes_mf_noise_file",noise_file,PETSC_MAX_PATH_LEN-1,&flg);
58: if (flg) neP->fp = fopen(noise_file,"w");
59: else neP->fp = fopen("noise.out","w");
60: if (!neP->fp) SETERRQ(PETSC_ERR_FILE_OPEN,"Cannot open file");
61: PetscInfo(snes,"Creating Jorge's differencing parameter context\n");
63: *outneP = neP;
64: return(0);
65: }
69: PetscErrorCode DiffParameterDestroy_More(void *nePv)
70: {
71: DIFFPAR_MORE *neP = (DIFFPAR_MORE *)nePv;
75: /* Destroy work vectors and close output file */
76: VecDestroyVecs(neP->workv,3);
77: fclose(neP->fp);
78: PetscFree(neP);
79: return(0);
80: }
84: PetscErrorCode DiffParameterCompute_More(SNES snes,void *nePv,Vec x,Vec p,double *fnoise,double *hopt)
85: {
86: DIFFPAR_MORE *neP = (DIFFPAR_MORE *)nePv;
87: Vec w, xp, fvec; /* work vectors to use in computing h */
88: double zero = 0.0, hl, hu, h, fnoise_s, fder2_s;
89: PetscScalar alpha;
90: PetscScalar fval[7], tab[7][7], eps[7], f;
91: double rerrf, fder2;
93: PetscInt iter, k, i, j, info;
94: PetscInt nf = 7; /* number of function evaluations */
95: PetscInt fcount;
96: MPI_Comm comm = snes->comm;
97: FILE *fp;
98: PetscTruth noise_test;
101: /* Call to SNESSetUp() just to set data structures in SNES context */
102: if (!snes->setupcalled) {SNESSetUp(snes);}
104: w = neP->workv[0];
105: xp = neP->workv[1];
106: fvec = neP->workv[2];
107: fp = neP->fp;
109: /* Initialize parameters */
110: hl = zero;
111: hu = zero;
112: h = neP->h_first_try;
113: fnoise_s = zero;
114: fder2_s = zero;
115: fcount = neP->function_count;
117: /* We have 5 tries to attempt to compute a good hopt value */
118: SNESGetIterationNumber(snes,&i);
119: PetscFPrintf(comm,fp,"\n ------- SNES iteration %D ---------\n",i);
120: for (iter=0; iter<5; iter++) {
121: neP->h_first_try = h;
123: /* Compute the nf function values needed to estimate the noise from
124: the difference table */
125: for (k=0; k<nf; k++) {
126: alpha = h * ( k+1 - (nf+1)/2 );
127: VecWAXPY(xp,alpha,p,x);
128: SNESComputeFunction(snes,xp,fvec);
129: neP->function_count++;
130: VecDot(fvec,w,&fval[k]);
131: }
132: f = fval[(nf+1)/2 - 1];
134: /* Construct the difference table */
135: for (i=0; i<nf; i++) {
136: tab[i][0] = fval[i];
137: }
138: for (j=0; j<6; j++) {
139: for (i=0; i<nf-j; i++) {
140: tab[i][j+1] = tab[i+1][j] - tab[i][j];
141: }
142: }
144: /* Print the difference table */
145: PetscFPrintf(comm,fp,"Difference Table: iter = %D\n",iter);
146: for (i=0; i<nf; i++) {
147: for (j=0; j<nf-i; j++) {
148: PetscFPrintf(comm,fp," %10.2e ",tab[i][j]);
149: }
150: PetscFPrintf(comm,fp,"\n");
151: }
153: /* Call the noise estimator */
154: dnest_(&nf,fval,&h,fnoise,&fder2,hopt,&info,eps);
156: /* Output statements */
157: rerrf = *fnoise/PetscAbsScalar(f);
158: if (info == 1) {PetscFPrintf(comm,fp,"%s\n","Noise detected");}
159: if (info == 2) {PetscFPrintf(comm,fp,"%s\n","Noise not detected; h is too small");}
160: if (info == 3) {PetscFPrintf(comm,fp,"%s\n","Noise not detected; h is too large");}
161: if (info == 4) {PetscFPrintf(comm,fp,"%s\n","Noise detected, but unreliable hopt");}
162: PetscFPrintf(comm,fp,"Approximate epsfcn %G %G %G %G %G %G\n",
163: eps[0],eps[1],eps[2],eps[3],eps[4],eps[5]);
164: PetscFPrintf(comm,fp,"h = %G, fnoise = %G, fder2 = %G, rerrf = %G, hopt = %G\n\n",
165: h, *fnoise, fder2, rerrf, *hopt);
167: /* Save fnoise and fder2. */
168: if (*fnoise) fnoise_s = *fnoise;
169: if (fder2) fder2_s = fder2;
171: /* Check for noise detection. */
172: if (fnoise_s && fder2_s) {
173: *fnoise = fnoise_s;
174: fder2 = fder2_s;
175: *hopt = 1.68*sqrt(*fnoise/PetscAbsScalar(fder2));
176: goto theend;
177: } else {
179: /* Update hl and hu, and determine new h */
180: if (info == 2 || info == 4) {
181: hl = h;
182: if (hu == zero) h = 100*h;
183: else h = PetscMin(100*h,0.1*hu);
184: } else if (info == 3) {
185: hu = h;
186: h = PetscMax(1.0e-3,sqrt(hl/hu))*hu;
187: }
188: }
189: }
190: theend:
192: if (*fnoise < neP->fnoise_min) {
193: PetscFPrintf(comm,fp,"Resetting fnoise: fnoise1 = %G, fnoise_min = %G\n",*fnoise,neP->fnoise_min);
194: *fnoise = neP->fnoise_min;
195: neP->fnoise_resets++;
196: }
197: if (*hopt < neP->hopt_min) {
198: PetscFPrintf(comm,fp,"Resetting hopt: hopt1 = %G, hopt_min = %G\n",*hopt,neP->hopt_min);
199: *hopt = neP->hopt_min;
200: neP->hopt_resets++;
201: }
203: PetscFPrintf(comm,fp,"Errors in derivative:\n");
204: PetscFPrintf(comm,fp,"f = %G, fnoise = %G, fder2 = %G, hopt = %G\n",f,*fnoise,fder2,*hopt);
206: /* For now, compute h **each** MV Mult!! */
207: /*
208: PetscOptionsHasName(PETSC_NULL,"-matrix_free_jorge_each_mvp",&flg);
209: if (!flg) {
210: Mat mat;
211: SNESGetJacobian(snes,&mat,PETSC_NULL,PETSC_NULL);
212: SNESDefaultMatrixFreeSetParameters2(mat,PETSC_DEFAULT,PETSC_DEFAULT,*hopt);
213: }
214: */
215: fcount = neP->function_count - fcount;
216: PetscInfo5(snes,"fct_now = %D, fct_cum = %D, rerrf=%G, sqrt(noise)=%G, h_more=%G\n",fcount,neP->function_count,rerrf,sqrt(*fnoise),*hopt);
218: PetscOptionsHasName(PETSC_NULL,"-noise_test",&noise_test);
219: if (noise_test) {
220: JacMatMultCompare(snes,x,p,*hopt);
221: }
222: return(0);
223: }
227: PetscErrorCode JacMatMultCompare(SNES snes,Vec x,Vec p,double hopt)
228: {
229: Vec yy1, yy2; /* work vectors */
230: PetscViewer view2; /* viewer */
231: Mat J; /* analytic Jacobian (set as preconditioner matrix) */
232: Mat Jmf; /* matrix-free Jacobian (set as true system matrix) */
233: double h; /* differencing parameter */
234: Vec f;
235: MatStructure sparsity = DIFFERENT_NONZERO_PATTERN;
236: PetscScalar alpha;
237: PetscReal yy1n,yy2n,enorm;
239: PetscInt i;
240: PetscTruth printv;
241: char filename[32];
242: MPI_Comm comm = snes->comm;
246: /* Compute function and analytic Jacobian at x */
247: SNESGetJacobian(snes,&Jmf,&J,PETSC_NULL,PETSC_NULL);
248: SNESComputeJacobian(snes,x,&Jmf,&J,&sparsity);
249: SNESGetFunction(snes,&f,PETSC_NULL,PETSC_NULL);
250: SNESComputeFunction(snes,x,f);
252: /* Duplicate work vectors */
253: VecDuplicate(x,&yy2);
254: VecDuplicate(x,&yy1);
256: /* Compute true matrix-vector product */
257: MatMult(J,p,yy1);
258: VecNorm(yy1,NORM_2,&yy1n);
260: /* View product vector if desired */
261: PetscOptionsHasName(PETSC_NULL,"-print_vecs",&printv);
262: if (printv) {
263: PetscViewerASCIIOpen(comm,"y1.out",&view2);
264: PetscViewerSetFormat(view2,PETSC_VIEWER_ASCII_COMMON);
265: VecView(yy1,view2);
266: PetscViewerDestroy(view2);
267: }
269: /* Test Jacobian-vector product computation */
270: alpha = -1.0;
271: h = 0.01 * hopt;
272: for (i=0; i<5; i++) {
273: /* Set differencing parameter for matrix-free multiplication */
274: SNESDefaultMatrixFreeSetParameters2(Jmf,PETSC_DEFAULT,PETSC_DEFAULT,h);
276: /* Compute matrix-vector product via differencing approximation */
277: MatMult(Jmf,p,yy2);
278: VecNorm(yy2,NORM_2,&yy2n);
280: /* View product vector if desired */
281: if (printv) {
282: sprintf(filename,"y2.%d.out",(int)i);
283: PetscViewerASCIIOpen(comm,filename,&view2);
284: PetscViewerSetFormat(view2,PETSC_VIEWER_ASCII_COMMON);
285: VecView(yy2,view2);
286: PetscViewerDestroy(view2);
287: }
289: /* Compute relative error */
290: VecAXPY(yy2,alpha,yy1);
291: VecNorm(yy2,NORM_2,&enorm);
292: enorm = enorm/yy1n;
293: PetscFPrintf(comm,stdout,"h = %G: relative error = %G\n",h,enorm);
294: h *= 10.0;
295: }
296: return(0);
297: }
299: static PetscInt lin_its_total = 0;
301: PetscErrorCode MyMonitor(SNES snes,PetscInt its,double fnorm,void *dummy)
302: {
304: PetscInt lin_its;
307: SNESGetLinearSolveIterations(snes,&lin_its);
308: lin_its_total += lin_its;
309: PetscPrintf(snes->comm, "iter = %D, SNES Function norm = %G, lin_its = %D, total_lin_its = %D\n",its,fnorm,lin_its,lin_its_total);
311: SNESUnSetMatrixFreeParameter(snes);
312: return(0);
313: }