Actual source code: zsnes.c
2: #include src/fortran/custom/zpetsc.h
3: #include petscsnes.h
4: #include petscda.h
6: #ifdef PETSC_HAVE_FORTRAN_UNDERSCORE_UNDERSCORE
7: #define snesconverged_tr_ snesconverged_tr__
8: #define snesconverged_ls_ snesconverged_ls__
9: #endif
11: #ifdef PETSC_HAVE_FORTRAN_CAPS
12: #define dmmgsetsnes_ DMMGSETSNES
13: #define matcreatedaad_ MATCREATEDAAD
14: #define matregisterdaad_ MATREGISTERDAAD
15: #define matdaadsetsnes_ MATDAADSETSNES
16: #define snesdacomputejacobian_ SNESDACOMPUTEJACOBIAN
17: #define snesdacomputejacobianwithadifor_ SNESDACOMPUTEJACOBIANWITHADIFOR
18: #define snesdaformfunction_ SNESDAFORMFUNCTION
19: #define snesconverged_tr_ SNESCONVERGED_TR
20: #define snesconverged_ls_ SNESCONVERGED_LS
21: #define snesgetconvergedreason_ SNESGETCONVERGEDREASON
22: #define snesdefaultmonitor_ SNESDEFAULTMONITOR
23: #define snesvecviewmonitor_ SNESVECVIEWMONITOR
24: #define sneslgmonitor_ SNESLGMONITOR
25: #define snesvecviewupdatemonitor_ SNESVECVIEWUPDATEMONITOR
26: #define snesregisterdestroy_ SNESREGISTERDESTROY
27: #define snessetjacobian_ SNESSETJACOBIAN
28: #define snescreate_ SNESCREATE
29: #define snessetfunction_ SNESSETFUNCTION
30: #define snesgetksp_ SNESGETKSP
31: #define snessetmonitor_ SNESSETMONITOR
32: #define snessetconvergencetest_ SNESSETCONVERGENCETEST
33: #define snesregisterdestroy_ SNESREGISTERDESTROY
34: #define snesgetsolution_ SNESGETSOLUTION
35: #define snesgetsolutionupdate_ SNESGETSOLUTIONUPDATE
36: #define snesgetfunction_ SNESGETFUNCTION
37: #define snesdestroy_ SNESDESTROY
38: #define snesgettype_ SNESGETTYPE
39: #define snessetoptionsprefix_ SNESSETOPTIONSPREFIX
40: #define snesappendoptionsprefix_ SNESAPPENDOPTIONSPREFIX
41: #define matcreatesnesmf_ MATCREATESNESMF
42: #define matcreatemf_ MATCREATEMF
43: #define snessettype_ SNESSETTYPE
44: #define snesgetconvergencehistory_ SNESGETCONVERGENCEHISTORY
45: #define snesdefaultcomputejacobian_ SNESDEFAULTCOMPUTEJACOBIAN
46: #define snesdefaultcomputejacobiancolor_ SNESDEFAULTCOMPUTEJACOBIANCOLOR
47: #define matsnesmfsettype_ MATSNESMFSETTYPE
48: #define snesgetoptionsprefix_ SNESGETOPTIONSPREFIX
49: #define snesgetjacobian_ SNESGETJACOBIAN
50: #define matsnesmfsetfunction_ MATSNESMFSETFUNCTION
51: #define sneslinesearchsetparams_ SNESLINESEARCHSETPARAMS
52: #define sneslinesearchgetparams_ SNESLINESEARCHGETPARAMS
53: #define sneslinesearchset_ SNESLINESEARCHSET
54: #define sneslinesearchsetpostcheck_ SNESLINESEARCHSETPOSTCHECK
55: #define sneslinesearchsetprecheck_ SNESLINESEARCHSETPRECHECK
56: #define snessetupdate_ SNESSETUPDATE
57: #define sneslinesearchcubic_ SNESLINESEARCHCUBIC
58: #define sneslinesearchquadratic_ SNESLINESEARCHQUADRATIC
59: #define sneslinesearchno_ SNESLINESEARCHNO
60: #define sneslinesearchnonorms_ SNESLINESEARCHNONORMS
61: #define snesview_ SNESVIEW
62: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
63: #define dmmgsetsnes_ dmmgsetsnes
64: #define matcreatedaad_ matcreatedaad
65: #define matregisterdaad_ matregisterdaad
66: #define matdaadsetsnes_ matdaadsetsnes
67: #define snesdacomputejacobian_ snesdacomputejacobian
68: #define snesdacomputejacobianwithadifor_ snesdacomputejacobianwithadifor
69: #define snesdaformfunction_ snesdaformfunction
70: #define sneslinesearchcubic_ sneslinesearchcubic
71: #define sneslinesearchquadratic_ sneslinesearchquadratic
72: #define sneslinesearchno_ sneslinesearchno
73: #define sneslinesearchnonorms_ sneslinesearchnonorms
74: #define sneslinesearchsetparams_ sneslinesearchsetparams
75: #define sneslinesearchgetparams_ sneslinesearchgetparams
76: #define sneslinesearchset_ sneslinesearchset
77: #define sneslinesearchsetpostcheck_ sneslinesearchsetpostcheck
78: #define sneslinesearchsetprecheck_ sneslinesearchsetprecheck
79: #define snessetupdate_ snessetupdate
80: #define snesconverged_tr_ snesconverged_tr
81: #define snesconverged_ls_ snesconverged_ls
82: #define snesgetconvergedreason_ snesgetconvergedreason
83: #define sneslgmonitor_ sneslgmonitor
84: #define snesdefaultmonitor_ snesdefaultmonitor
85: #define snesvecviewmonitor_ snesvecviewmonitor
86: #define snesvecviewupdatemonitor_ snesvecviewupdatemonitor
87: #define matsnesmfsetfunction_ matsnesmfsetfunction
88: #define snesregisterdestroy_ snesregisterdestroy
89: #define snessetjacobian_ snessetjacobian
90: #define snescreate_ snescreate
91: #define snessetfunction_ snessetfunction
92: #define snesgetksp_ snesgetksp
93: #define snesdestroy_ snesdestroy
94: #define snessetmonitor_ snessetmonitor
95: #define snessetconvergencetest_ snessetconvergencetest
96: #define snesregisterdestroy_ snesregisterdestroy
97: #define snesgetsolution_ snesgetsolution
98: #define snesgetsolutionupdate_ snesgetsolutionupdate
99: #define snesgetfunction_ snesgetfunction
100: #define snesgettype_ snesgettype
101: #define snessetoptionsprefix_ snessetoptionsprefix
102: #define snesappendoptionsprefix_ snesappendoptionsprefix
103: #define matcreatesnesmf_ matcreatesnesmf
104: #define matcreatemf_ matcreatemf
105: #define snessettype_ snessettype
106: #define snesgetconvergencehistory_ snesgetconvergencehistory
107: #define snesdefaultcomputejacobian_ snesdefaultcomputejacobian
108: #define snesdefaultcomputejacobiancolor_ snesdefaultcomputejacobiancolor
109: #define matsnesmfsettype_ matsnesmfsettype
110: #define snesgetoptionsprefix_ snesgetoptionsprefix
111: #define snesgetjacobian_ snesgetjacobian
112: #define snesview_ snesview
113: #endif
116: static void (PETSC_STDCALL *f7)(SNES*,PetscInt*,PetscReal*,void*,PetscErrorCode*);
117: static void (PETSC_STDCALL *f71)(void*,PetscErrorCode*);
118: static void (PETSC_STDCALL *f8)(SNES*,PetscReal*,PetscReal*,PetscReal*,SNESConvergedReason*,void*,PetscErrorCode*);
119: static void (PETSC_STDCALL *f2)(SNES*,Vec*,Vec*,void*,PetscErrorCode*);
120: static void (PETSC_STDCALL *f11)(SNES*,Vec*,Vec*,void*,PetscErrorCode*);
121: static void (PETSC_STDCALL *f3)(SNES*,Vec*,Mat*,Mat*,MatStructure*,void*,PetscErrorCode*);
122: static void (PETSC_STDCALL *f73)(SNES*,void *,Vec*,Vec*,Vec*,Vec*,Vec*,PetscReal*,PetscReal*,PetscReal*,PetscTruth*,PetscErrorCode*);
123: static void (PETSC_STDCALL *f74)(SNES*,Vec*,Vec*,Vec*,void*,PetscTruth*,PetscTruth*,PetscErrorCode*);
124: static void (PETSC_STDCALL *f75)(SNES*,Vec*,Vec*,void*,PetscTruth*,PetscErrorCode*);
125: static void (PETSC_STDCALL *f76)(SNES*,PetscInt*,PetscErrorCode*);
129: PetscErrorCode OurSNESLineSearch(SNES snes,void *ctx,Vec x,Vec f,Vec g,Vec y,Vec w,PetscReal fnorm,PetscReal*ynorm,PetscReal*gnorm,PetscTruth *flag)
130: {
131: PetscErrorCode 0;
132: (*f73)(&snes,(void*)&ctx,&x,&f,&g,&y,&w,&fnorm,ynorm,gnorm,flag,&ierr);
133: return 0;
134: }
136: PetscErrorCode OurSNESLineSearchPostCheck(SNES snes,Vec x,Vec y,Vec z,void *checkCtx,PetscTruth *flag1,PetscTruth *flag2)
137: {
138: PetscErrorCode 0;
139: (*f74)(&snes,&x,&y,&z,(void*)&checkCtx,flag1,flag2,&ierr);
140: return 0;
141: }
143: PetscErrorCode OurSNESLineSearchPreCheck(SNES snes,Vec x,Vec y,void *checkCtx,PetscTruth *flag1)
144: {
145: PetscErrorCode 0;
146: (*f75)(&snes,&x,&y,(void*)&checkCtx,flag1,&ierr);
147: return 0;
148: }
149: PetscErrorCode OurSNESSetUpdate(SNES snes,PetscInt b)
150: {
151: PetscErrorCode 0;
152: (*f76)(&snes,&b,&ierr);
153: return 0;
154: }
155: static PetscErrorCode oursnesmonitor(SNES snes,PetscInt i,PetscReal d,void*ctx)
156: {
157: PetscErrorCode 0;
159: (*f7)(&snes,&i,&d,ctx,&ierr);
160: return 0;
161: }
162: static PetscErrorCode ourmondestroy(void* ctx)
163: {
164: PetscErrorCode 0;
166: (*f71)(ctx,&ierr);
167: return 0;
168: }
169: static PetscErrorCode oursnestest(SNES snes,PetscReal a,PetscReal d,PetscReal c,SNESConvergedReason*reason,void*ctx)
170: {
171: PetscErrorCode 0;
173: (*f8)(&snes,&a,&d,&c,reason,ctx,&ierr);
174: return 0;
175: }
176: static PetscErrorCode oursnesfunction(SNES snes,Vec x,Vec f,void *ctx)
177: {
178: PetscErrorCode 0;
179: (*f2)(&snes,&x,&f,ctx,&ierr);
180: return 0;
181: }
182: static PetscErrorCode ourmatsnesmffunction(SNES snes,Vec x,Vec f,void *ctx)
183: {
184: PetscErrorCode 0;
185: (*f11)(&snes,&x,&f,ctx,&ierr);
186: return 0;
187: }
188: static PetscErrorCode oursnesjacobian(SNES snes,Vec x,Mat* m,Mat* p,MatStructure* type,void*ctx)
189: {
190: PetscErrorCode 0;
191: (*f3)(&snes,&x,m,p,type,ctx,&ierr);
192: return 0;
193: }
197: #if defined(notused)
198: static PetscErrorCode ourrhs(SNES snes,Vec vec,Vec vec2,void*ctx)
199: {
200: PetscErrorCode 0;
201: DMMG *dmmg = (DMMG*)ctx;
202: (*(PetscErrorCode (PETSC_STDCALL *)(SNES*,Vec*,Vec*,PetscErrorCode*))(((PetscObject)dmmg->dm)->fortran_func_pointers[0]))(&snes,&vec,&vec2,&ierr);
203: return ierr;
204: }
206: static PetscErrorCode ourmat(DMMG dmmg,Mat mat)
207: {
208: PetscErrorCode 0;
209: (*(PetscErrorCode (PETSC_STDCALL *)(DMMG*,Vec*,PetscErrorCode*))(((PetscObject)dmmg->dm)->fortran_func_pointers[1]))(&dmmg,&vec,&ierr);
210: return ierr;
211: }
213: void PETSC_STDCALL dmmgsetsnes_(DMMG **dmmg,PetscErrorCode (PETSC_STDCALL *rhs)(SNES*,Vec*,Vec*,PetscErrorCode*),PetscErrorCode (PETSC_STDCALL *mat)(DMMG*,Mat*,PetscErrorCode*),PetscErrorCode *ierr)
214: {
215: PetscInt i;
216: theirmat = mat;
217: *DMMGSetSNES(*dmmg,ourrhs,ourmat,*dmmg);
218: /*
219: Save the fortran rhs function in the DM on each level; ourrhs() pulls it out when needed
220: */
221: for (i=0; i<(**dmmg)->nlevels; i++) {
222: ((PetscObject)(*dmmg)[i]->dm)->fortran_func_pointers[0] = (FCNVOID)rhs;
223: ((PetscObject)(*dmmg)[i]->dm)->fortran_func_pointers[1] = (FCNVOID)mat;
224: }
225: }
227: #endif
229: #if defined (PETSC_HAVE_ADIC)
230: void PETSC_STDCALL matregisterdaad_(PetscErrorCode *ierr)
231: {
232: *MatRegisterDAAD();
233: }
235: void PETSC_STDCALL matcreatedaad_(DA *da,Mat *mat,PetscErrorCode *ierr)
236: {
237: *MatCreateDAAD(*da,mat);
238: }
240: void PETSC_STDCALL matdaadsetsnes_(Mat *mat,SNES *snes,PetscErrorCode *ierr)
241: {
242: *MatDAADSetSNES(*mat,*snes);
243: }
244: #endif
246: void PETSC_STDCALL snesview_(SNES *snes,PetscViewer *viewer, PetscErrorCode *ierr)
247: {
248: PetscViewer v;
249: PetscPatchDefaultViewers_Fortran(viewer,v);
250: *SNESView(*snes,v);
251: }
253: void PETSC_STDCALL snesgetconvergedreason_(SNES *snes,SNESConvergedReason *r,PetscErrorCode *ierr)
254: {
255: *SNESGetConvergedReason(*snes,r);
256: }
258: void PETSC_STDCALL sneslinesearchsetparams_(SNES *snes,PetscReal *alpha,PetscReal *maxstep,PetscReal *steptol,PetscErrorCode *ierr)
259: {
260: *SNESLineSearchSetParams(*snes,*alpha,*maxstep,*steptol);
261: }
263: void PETSC_STDCALL sneslinesearchgetparams_(SNES *snes,PetscReal *alpha,PetscReal *maxstep,PetscReal *steptol,PetscErrorCode *ierr)
264: {
265: CHKFORTRANNULLREAL(alpha);
266: CHKFORTRANNULLREAL(maxstep);
267: CHKFORTRANNULLREAL(steptol);
268: *SNESLineSearchGetParams(*snes,alpha,maxstep,steptol);
269: }
271: /* func is currently ignored from Fortran */
272: void PETSC_STDCALL snesgetjacobian_(SNES *snes,Mat *A,Mat *B,int *func,void **ctx,PetscErrorCode *ierr)
273: {
274: CHKFORTRANNULLINTEGER(ctx);
275: CHKFORTRANNULLOBJECT(A);
276: CHKFORTRANNULLOBJECT(B);
277: *SNESGetJacobian(*snes,A,B,0,ctx);
278: }
280: void PETSC_STDCALL matsnesmfsettype_(Mat *mat,CHAR ftype PETSC_MIXED_LEN(len),
281: PetscErrorCode *ierr PETSC_END_LEN(len))
282: {
283: char *t;
284: FIXCHAR(ftype,len,t);
285: *MatSNESMFSetType(*mat,t);
286: FREECHAR(ftype,t);
287: }
289: void PETSC_STDCALL snesgetconvergencehistory_(SNES *snes,PetscInt *na,PetscErrorCode *ierr)
290: {
291: *SNESGetConvergenceHistory(*snes,PETSC_NULL,PETSC_NULL,na);
292: }
294: void PETSC_STDCALL snessettype_(SNES *snes,CHAR type PETSC_MIXED_LEN(len),
295: PetscErrorCode *ierr PETSC_END_LEN(len))
296: {
297: char *t;
299: FIXCHAR(type,len,t);
300: *SNESSetType(*snes,t);
301: FREECHAR(type,t);
302: }
304: void PETSC_STDCALL snesappendoptionsprefix_(SNES *snes,CHAR prefix PETSC_MIXED_LEN(len),
305: PetscErrorCode *ierr PETSC_END_LEN(len))
306: {
307: char *t;
309: FIXCHAR(prefix,len,t);
310: *SNESAppendOptionsPrefix(*snes,t);
311: FREECHAR(prefix,t);
312: }
314: void PETSC_STDCALL matcreatesnesmf_(SNES *snes,Vec *x,Mat *J,PetscErrorCode *ierr)
315: {
316: *MatCreateSNESMF(*snes,*x,J);
317: }
319: void PETSC_STDCALL matcreatemf_(Vec *x,Mat *J,PetscErrorCode *ierr)
320: {
321: *MatCreateMF(*x,J);
322: }
324: /* functions, hence no STDCALL */
326: void sneslgmonitor_(SNES *snes,PetscInt *its,PetscReal *fgnorm,void *dummy,PetscErrorCode *ierr)
327: {
328: *SNESLGMonitor(*snes,*its,*fgnorm,dummy);
329: }
331: void snesdefaultmonitor_(SNES *snes,PetscInt *its,PetscReal *fgnorm,void *dummy,PetscErrorCode *ierr)
332: {
333: *SNESDefaultMonitor(*snes,*its,*fgnorm,dummy);
334: }
336: void snesvecviewmonitor_(SNES *snes,PetscInt *its,PetscReal *fgnorm,void *dummy,PetscErrorCode *ierr)
337: {
338: *SNESVecViewMonitor(*snes,*its,*fgnorm,dummy);
339: }
341: void snesvecviewupdatemonitor_(SNES *snes,PetscInt *its,PetscReal *fgnorm,void *dummy,PetscErrorCode *ierr)
342: {
343: *SNESVecViewUpdateMonitor(*snes,*its,*fgnorm,dummy);
344: }
347: void PETSC_STDCALL snessetmonitor_(SNES *snes,void (PETSC_STDCALL *func)(SNES*,PetscInt*,PetscReal*,void*,PetscErrorCode*),
348: void *mctx,void (PETSC_STDCALL *mondestroy)(void*,PetscErrorCode*),PetscErrorCode *ierr)
349: {
350: CHKFORTRANNULLOBJECT(mctx);
351: if ((FCNVOID)func == (FCNVOID)snesdefaultmonitor_) {
352: *SNESSetMonitor(*snes,SNESDefaultMonitor,0,0);
353: } else if ((FCNVOID)func == (FCNVOID)snesvecviewmonitor_) {
354: *SNESSetMonitor(*snes,SNESVecViewMonitor,0,0);
355: } else if ((FCNVOID)func == (FCNVOID)snesvecviewupdatemonitor_) {
356: *SNESSetMonitor(*snes,SNESVecViewUpdateMonitor,0,0);
357: } else if ((FCNVOID)func == (FCNVOID)sneslgmonitor_) {
358: *SNESSetMonitor(*snes,SNESLGMonitor,0,0);
359: } else {
360: f7 = func;
361: if (FORTRANNULLFUNCTION(mondestroy)){
362: *SNESSetMonitor(*snes,oursnesmonitor,mctx,0);
363: } else {
364: f71 = mondestroy;
365: *SNESSetMonitor(*snes,oursnesmonitor,mctx,ourmondestroy);
366: }
367: }
368: }
370: /* -----------------------------------------------------------------------------------------------------*/
371: void sneslinesearchcubic_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
372: PetscReal *ynorm,PetscReal *gnorm,PetscTruth *flag,PetscErrorCode *ierr)
373: {
374: *SNESLineSearchCubic(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
375: }
376: void sneslinesearchquadratic_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
377: PetscReal *ynorm,PetscReal *gnorm,PetscTruth *flag,PetscErrorCode *ierr)
378: {
379: *SNESLineSearchQuadratic(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
380: }
381: void sneslinesearchno_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
382: PetscReal *ynorm,PetscReal *gnorm,PetscTruth *flag,PetscErrorCode *ierr)
383: {
384: *SNESLineSearchNo(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
385: }
386: void sneslinesearchnonorms_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
387: PetscReal *ynorm,PetscReal *gnorm,PetscTruth *flag,PetscErrorCode *ierr)
388: {
389: *SNESLineSearchNoNorms(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
390: }
393: void PETSC_STDCALL sneslinesearchset_(SNES *snes,void (PETSC_STDCALL *f)(SNES*,void *,Vec*,Vec*,Vec*,Vec*,Vec*,PetscReal*,PetscReal*,PetscReal*,PetscTruth*,PetscErrorCode*),void *ctx,PetscErrorCode *ierr)
394: {
395: if ((FCNVOID)f == (FCNVOID)sneslinesearchcubic_) {
396: *SNESLineSearchSet(*snes,SNESLineSearchCubic,ctx);
397: } else if ((FCNVOID)f == (FCNVOID)sneslinesearchquadratic_) {
398: *SNESLineSearchSet(*snes,SNESLineSearchQuadratic,ctx);
399: } else if ((FCNVOID)f == (FCNVOID)sneslinesearchno_) {
400: *SNESLineSearchSet(*snes,SNESLineSearchNo,ctx);
401: } else if ((FCNVOID)f == (FCNVOID)sneslinesearchnonorms_) {
402: *SNESLineSearchSet(*snes,SNESLineSearchNoNorms,ctx);
403: } else {
404: f73 = f;
405: *SNESLineSearchSet(*snes,OurSNESLineSearch,ctx);
406: }
407: }
410: void PETSC_STDCALL sneslinesearchsetpostcheck_(SNES *snes,void (PETSC_STDCALL *f)(SNES*,Vec*,Vec *,Vec *,void *,PetscTruth*,PetscTruth*,PetscErrorCode*),void *ctx,PetscErrorCode *ierr)
411: {
412: f74 = f;
413: *SNESLineSearchSetPostCheck(*snes,OurSNESLineSearchPostCheck,ctx);
414: }
416: void PETSC_STDCALL sneslinesearchsetprecheck_(SNES *snes,void (PETSC_STDCALL *f)(SNES*,Vec*,Vec *,void *,PetscTruth*,PetscErrorCode*),void *ctx,PetscErrorCode *ierr)
417: {
418: f75 = f;
419: *SNESLineSearchSetPreCheck(*snes,OurSNESLineSearchPreCheck,ctx);
420: }
422: void PETSC_STDCALL snessetupdate_(SNES *snes,void (PETSC_STDCALL *f)(SNES*,PetscInt*,PetscErrorCode*),PetscErrorCode *ierr)
423: {
424: f76 = f;
425: *SNESSetUpdate(*snes,OurSNESSetUpdate);
426: }
427: /*----------------------------------------------------------------------*/
429: void snesconverged_tr_(SNES *snes,PetscReal *a,PetscReal *b,PetscReal *c,SNESConvergedReason *r,
430: void *ct,PetscErrorCode *ierr)
431: {
432: *SNESConverged_TR(*snes,*a,*b,*c,r,ct);
433: }
435: void snesconverged_ls_(SNES *snes,PetscReal *a,PetscReal *b,PetscReal *c,SNESConvergedReason *r,
436: void *ct,PetscErrorCode *ierr)
437: {
438: *SNESConverged_LS(*snes,*a,*b,*c,r,ct);
439: }
442: void PETSC_STDCALL snessetconvergencetest_(SNES *snes,
443: void (PETSC_STDCALL *func)(SNES*,PetscReal*,PetscReal*,PetscReal*,SNESConvergedReason*,void*,PetscErrorCode*),
444: void *cctx,PetscErrorCode *ierr)
445: {
446: CHKFORTRANNULLOBJECT(cctx);
447: if ((FCNVOID)func == (FCNVOID)snesconverged_ls_){
448: *SNESSetConvergenceTest(*snes,SNESConverged_LS,0);
449: } else if ((FCNVOID)func == (FCNVOID)snesconverged_tr_){
450: *SNESSetConvergenceTest(*snes,SNESConverged_TR,0);
451: } else {
452: f8 = func;
453: *SNESSetConvergenceTest(*snes,oursnestest,cctx);
454: }
455: }
457: /*--------------------------------------------------------------------------------------------*/
459: void PETSC_STDCALL snesgetsolution_(SNES *snes,Vec *x,PetscErrorCode *ierr)
460: {
461: *SNESGetSolution(*snes,x);
462: }
464: void PETSC_STDCALL snesgetsolutionupdate_(SNES *snes,Vec *x,PetscErrorCode *ierr)
465: {
466: *SNESGetSolutionUpdate(*snes,x);
467: }
469: /* the func argument is ignored */
470: void PETSC_STDCALL snesgetfunction_(SNES *snes,Vec *r,void *func,void **ctx,PetscErrorCode *ierr)
471: {
472: CHKFORTRANNULLINTEGER(ctx);
473: CHKFORTRANNULLOBJECT(r);
474: *SNESGetFunction(*snes,r,PETSC_NULL,ctx);
475: }
477: void PETSC_STDCALL snesdestroy_(SNES *snes,PetscErrorCode *ierr)
478: {
479: *SNESDestroy(*snes);
480: }
482: void PETSC_STDCALL snesgetksp_(SNES *snes,KSP *ksp,PetscErrorCode *ierr)
483: {
484: *SNESGetKSP(*snes,ksp);
485: }
487: /* ---------------------------------------------------------*/
490: /*
491: These are not usually called from Fortran but allow Fortran users
492: to transparently set these monitors from .F code
493:
494: functions, hence no STDCALL
495: */
496: void snesdaformfunction_(SNES *snes,Vec *X, Vec *F,void *ptr,PetscErrorCode *ierr)
497: {
498: *SNESDAFormFunction(*snes,*X,*F,ptr);
499: }
502: void PETSC_STDCALL snessetfunction_(SNES *snes,Vec *r,void (PETSC_STDCALL *func)(SNES*,Vec*,Vec*,void*,PetscErrorCode*),
503: void *ctx,PetscErrorCode *ierr)
504: {
505: CHKFORTRANNULLOBJECT(ctx);
506: f2 = func;
507: if ((FCNVOID)func == (FCNVOID)snesdaformfunction_) {
508: *SNESSetFunction(*snes,*r,SNESDAFormFunction,ctx);
509: } else {
510: *SNESSetFunction(*snes,*r,oursnesfunction,ctx);
511: }
512: }
514: /* ---------------------------------------------------------*/
516: void PETSC_STDCALL matsnesmfsetfunction_(Mat *mat,Vec *r,void (PETSC_STDCALL *func)(SNES*,Vec*,Vec*,void*,PetscErrorCode*),
517: void *ctx,PetscErrorCode *ierr){
518: f11 = func;
519: CHKFORTRANNULLOBJECT(ctx);
520: *MatSNESMFSetFunction(*mat,*r,ourmatsnesmffunction,ctx);
521: }
522: /* ---------------------------------------------------------*/
524: void PETSC_STDCALL snescreate_(MPI_Comm *comm,SNES *outsnes,PetscErrorCode *ierr){
526: *SNESCreate((MPI_Comm)PetscToPointerComm(*comm),outsnes);
527: }
529: /* ---------------------------------------------------------*/
530: /*
531: snesdefaultcomputejacobian() and snesdefaultcomputejacobiancolor()
532: These can be used directly from Fortran but are mostly so that
533: Fortran SNESSetJacobian() will properly handle the defaults being passed in.
535: functions, hence no STDCALL
536: */
537: void snesdefaultcomputejacobian_(SNES *snes,Vec *x,Mat *m,Mat *p,MatStructure* type,void *ctx,PetscErrorCode *ierr)
538: {
539: *SNESDefaultComputeJacobian(*snes,*x,m,p,type,ctx);
540: }
541: void snesdefaultcomputejacobiancolor_(SNES *snes,Vec *x,Mat *m,Mat *p,MatStructure* type,void *ctx,PetscErrorCode *ierr)
542: {
543: *SNESDefaultComputeJacobianColor(*snes,*x,m,p,type,*(MatFDColoring*)ctx);
544: }
546: void snesdacomputejacobianwithadifor_(SNES *snes,Vec *X,Mat *m,Mat *p,MatStructure* type,void *ctx,PetscErrorCode *ierr)
547: {
548: (*PetscErrorPrintf)("Cannot call this function from Fortran");
549: *1;
550: }
552: void snesdacomputejacobian_(SNES *snes,Vec *X,Mat *m,Mat *p,MatStructure* type,void *ctx,PetscErrorCode *ierr)
553: {
554: (*PetscErrorPrintf)("Cannot call this function from Fortran");
555: *1;
556: }
558: void PETSC_STDCALL snessetjacobian_(SNES *snes,Mat *A,Mat *B,void (PETSC_STDCALL *func)(SNES*,Vec*,Mat*,Mat*,
559: MatStructure*,void*,PetscErrorCode*),void *ctx,PetscErrorCode *ierr)
560: {
561: CHKFORTRANNULLOBJECT(ctx);
562: if ((FCNVOID)func == (FCNVOID)snesdefaultcomputejacobian_) {
563: *SNESSetJacobian(*snes,*A,*B,SNESDefaultComputeJacobian,ctx);
564: } else if ((FCNVOID)func == (FCNVOID)snesdefaultcomputejacobiancolor_) {
565: *SNESSetJacobian(*snes,*A,*B,SNESDefaultComputeJacobianColor,*(MatFDColoring*)ctx);
566: } else if ((FCNVOID)func == (FCNVOID)snesdacomputejacobianwithadifor_) {
567: *SNESSetJacobian(*snes,*A,*B,SNESDAComputeJacobianWithAdifor,ctx);
568: } else if ((FCNVOID)func == (FCNVOID)snesdacomputejacobian_) {
569: *SNESSetJacobian(*snes,*A,*B,SNESDAComputeJacobian,ctx);
570: } else {
571: f3 = func;
572: *SNESSetJacobian(*snes,*A,*B,oursnesjacobian,ctx);
573: }
574: }
576: /* -------------------------------------------------------------*/
578: void PETSC_STDCALL snesregisterdestroy_(PetscErrorCode *ierr)
579: {
580: *SNESRegisterDestroy();
581: }
583: void PETSC_STDCALL snesgettype_(SNES *snes,CHAR name PETSC_MIXED_LEN(len),
584: PetscErrorCode *ierr PETSC_END_LEN(len))
585: {
586: const char *tname;
588: *SNESGetType(*snes,&tname);
589: #if defined(PETSC_USES_CPTOFCD)
590: {
591: char *t = _fcdtocp(name); int len1 = _fcdlen(name);
592: *PetscStrncpy(t,tname,len1);if (*ierr) return;
593: }
594: #else
595: *PetscStrncpy(name,tname,len);if (*ierr) return;
596: #endif
597: FIXRETURNCHAR(name,len);
598: }
600: void PETSC_STDCALL snesgetoptionsprefix_(SNES *snes,CHAR prefix PETSC_MIXED_LEN(len),
601: PetscErrorCode *ierr PETSC_END_LEN(len))
602: {
603: const char *tname;
605: *SNESGetOptionsPrefix(*snes,&tname);
606: #if defined(PETSC_USES_CPTOFCD)
607: {
608: char *t = _fcdtocp(prefix); int len1 = _fcdlen(prefix);
609: *PetscStrncpy(t,tname,len1);if (*ierr) return;
610: }
611: #else
612: *PetscStrncpy(prefix,tname,len);if (*ierr) return;
613: #endif
614: }