Actual source code: zsnesf.c
1: #include <petsc/private/fortranimpl.h>
2: #include <petscsnes.h>
3: #include <petscviewer.h>
4: #include <petsc/private/f90impl.h>
6: #if defined(PETSC_HAVE_FORTRAN_CAPS)
7: #define snessetpicard_ SNESSETPICARD
8: #define snessetpicardnointerface_ SNESSETPICARDNOINTERFACE
9: #define snessolve_ SNESSOLVE
10: #define snescomputejacobiandefault_ SNESCOMPUTEJACOBIANDEFAULT
11: #define snescomputejacobiandefaultcolor_ SNESCOMPUTEJACOBIANDEFAULTCOLOR
12: #define snessetjacobian_ SNESSETJACOBIAN
13: #define snessetjacobiannointerface_ SNESSETJACOBIANNOINTERFACE
14: #define snessetfunction_ SNESSETFUNCTION
15: #define snessetfunctionnointerface_ SNESSETFUNCTIONNOINTERFACE
16: #define snessetobjective_ SNESSETOBJECTIVE
17: #define snessetobjectivenointerface_ SNESSETOBJECTIVENOINTERFACE
18: #define snessetngs_ SNESSETNGS
19: #define snessetupdate_ SNESSETUPDATE
20: #define snesgetfunction_ SNESGETFUNCTION
21: #define snesgetngs_ SNESGETNGS
22: #define snessetconvergencetest_ SNESSETCONVERGENCETEST
23: #define snesconvergeddefault_ SNESCONVERGEDDEFAULT
24: #define snesconvergedskip_ SNESCONVERGEDSKIP
25: #define snesgetconvergencehistory_ SNESGETCONVERGENCEHISTORY
26: #define snesgetjacobian_ SNESGETJACOBIAN
27: #define snesmonitordefault_ SNESMONITORDEFAULT
28: #define snesmonitorsolution_ SNESMONITORSOLUTION
29: #define snesmonitorsolutionupdate_ SNESMONITORSOLUTIONUPDATE
30: #define snesmonitorset_ SNESMONITORSET
31: #define snesnewtontrsetprecheck_ SNESNEWTONTRSETPRECHECK
32: #define snesnewtontrsetpostcheck_ SNESNEWTONTRSETPOSTCHECK
33: #define snesnewtontrdcsetprecheck_ SNESNEWTONTRDCSETPRECHECK
34: #define snesnewtontrdcsetpostcheck_ SNESNEWTONTRDCSETPOSTCHECK
35: #define matmffdcomputejacobian_ MATMFFDCOMPUTEJACOBIAN
36: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
37: #define snessetpicard_ snessetpicard
38: #define snessetpicardnointerface_ snessetpicardnointerface
39: #define snessolve_ snessolve
40: #define snescomputejacobiandefault_ snescomputejacobiandefault
41: #define snescomputejacobiandefaultcolor_ snescomputejacobiandefaultcolor
42: #define snessetjacobian_ snessetjacobian
43: #define snessetjacobiannointerface_ snessetjacobiannointerface
44: #define snessetfunction_ snessetfunction
45: #define snessetfunctionnointerface_ snessetfunctionnointerface
46: #define snessetobjective_ snessetobjective
47: #define snessetobjectivenointerface_ snessetobjectivenointerface
48: #define snessetngs_ snessetngs
49: #define snessetupdate_ snessetupdate
50: #define snesgetfunction_ snesgetfunction
51: #define snesgetngs_ snesgetngs
52: #define snessetconvergencetest_ snessetconvergencetest
53: #define snesconvergeddefault_ snesconvergeddefault
54: #define snesconvergedskip_ snesconvergedskip
55: #define snesgetjacobian_ snesgetjacobian
56: #define snesgetconvergencehistory_ snesgetconvergencehistory
57: #define snesmonitordefault_ snesmonitordefault
58: #define snesmonitorsolution_ snesmonitorsolution
59: #define snesmonitorsolutionupdate_ snesmonitorsolutionupdate
60: #define snesmonitorset_ snesmonitorset
61: #define snesnewtontrsetprecheck_ snesnewtontrsetprecheck
62: #define snesnewtontrsetpostcheck_ snesnewtontrsetpostcheck
63: #define snesnewtontrdcsetprecheck_ snesnewtontrdcsetprecheck
64: #define snesnewtontrdcsetpostcheck_ snesnewtontrdcsetpostcheck
65: #define matmffdcomputejacobian_ matmffdcomputejacobian
66: #endif
68: static struct {
69: PetscFortranCallbackId function;
70: PetscFortranCallbackId objective;
71: PetscFortranCallbackId test;
72: PetscFortranCallbackId destroy;
73: PetscFortranCallbackId jacobian;
74: PetscFortranCallbackId monitor;
75: PetscFortranCallbackId mondestroy;
76: PetscFortranCallbackId ngs;
77: PetscFortranCallbackId update;
78: PetscFortranCallbackId trprecheck;
79: PetscFortranCallbackId trpostcheck;
80: #if defined(PETSC_HAVE_F90_2PTR_ARG)
81: PetscFortranCallbackId function_pgiptr;
82: PetscFortranCallbackId objective_pgiptr;
83: PetscFortranCallbackId trprecheck_pgiptr;
84: PetscFortranCallbackId trpostcheck_pgiptr;
85: #endif
86: } _cb;
88: static PetscErrorCode ourtrprecheckfunction(SNES snes, Vec x, Vec y, PetscBool *changed_y, void *ctx)
89: {
90: #if defined(PETSC_HAVE_F90_2PTR_ARG)
91: void *ptr;
92: PetscCall(PetscObjectGetFortranCallback((PetscObject)snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.trprecheck_pgiptr, NULL, &ptr));
93: #endif
94: PetscObjectUseFortranCallback(snes, _cb.trprecheck, (SNES *, Vec *, Vec *, PetscBool *, void *, PetscErrorCode *PETSC_F90_2PTR_PROTO_NOVAR), (&snes, &x, &y, changed_y, _ctx, &ierr PETSC_F90_2PTR_PARAM(ptr)));
95: }
97: PETSC_EXTERN void snesnewtontrsetprecheck_(SNES *snes, void (*func)(SNES, Vec, Vec, PetscBool *, void *), void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
98: {
99: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trprecheck, (PetscVoidFn *)func, ctx);
100: if (*ierr) return;
101: #if defined(PETSC_HAVE_F90_2PTR_ARG)
102: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trprecheck_pgiptr, NULL, ptr);
103: if (*ierr) return;
104: #endif
105: *ierr = SNESNewtonTRSetPreCheck(*snes, ourtrprecheckfunction, NULL);
106: }
108: PETSC_EXTERN void snesnewtontrdcsetprecheck_(SNES *snes, void (*func)(SNES, Vec, Vec, PetscBool *, void *), void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
109: {
110: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trprecheck, (PetscVoidFn *)func, ctx);
111: if (*ierr) return;
112: #if defined(PETSC_HAVE_F90_2PTR_ARG)
113: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trprecheck_pgiptr, NULL, ptr);
114: if (*ierr) return;
115: #endif
116: *ierr = SNESNewtonTRDCSetPreCheck(*snes, ourtrprecheckfunction, NULL);
117: }
119: static PetscErrorCode ourtrpostcheckfunction(SNES snes, Vec x, Vec y, Vec w, PetscBool *changed_y, PetscBool *changed_w, void *ctx)
120: {
121: #if defined(PETSC_HAVE_F90_2PTR_ARG)
122: void *ptr;
123: PetscCall(PetscObjectGetFortranCallback((PetscObject)snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.trpostcheck_pgiptr, NULL, &ptr));
124: #endif
125: PetscObjectUseFortranCallback(snes, _cb.trpostcheck, (SNES *, Vec *, Vec *, Vec *, PetscBool *, PetscBool *, void *, PetscErrorCode *PETSC_F90_2PTR_PROTO_NOVAR), (&snes, &x, &y, &w, changed_y, changed_w, _ctx, &ierr PETSC_F90_2PTR_PARAM(ptr)));
126: }
128: PETSC_EXTERN void snesnewtontrsetpostcheck_(SNES *snes, void (*func)(SNES, Vec, Vec, Vec, PetscBool *, PetscBool *, void *), void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
129: {
130: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trpostcheck, (PetscVoidFn *)func, ctx);
131: if (*ierr) return;
132: #if defined(PETSC_HAVE_F90_2PTR_ARG)
133: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trpostcheck_pgiptr, NULL, ptr);
134: if (*ierr) return;
135: #endif
136: *ierr = SNESNewtonTRSetPostCheck(*snes, ourtrpostcheckfunction, NULL);
137: }
139: PETSC_EXTERN void snesnewtontrdcsetpostcheck_(SNES *snes, void (*func)(SNES, Vec, Vec, Vec, PetscBool *, PetscBool *, void *), void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
140: {
141: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trpostcheck, (PetscVoidFn *)func, ctx);
142: if (*ierr) return;
143: #if defined(PETSC_HAVE_F90_2PTR_ARG)
144: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trpostcheck_pgiptr, NULL, ptr);
145: if (*ierr) return;
146: #endif
147: *ierr = SNESNewtonTRDCSetPostCheck(*snes, ourtrpostcheckfunction, NULL);
148: }
150: static PetscErrorCode oursnesfunction(SNES snes, Vec x, Vec f, void *ctx)
151: {
152: #if defined(PETSC_HAVE_F90_2PTR_ARG)
153: void *ptr;
154: PetscCall(PetscObjectGetFortranCallback((PetscObject)snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.function_pgiptr, NULL, &ptr));
155: #endif
156: PetscObjectUseFortranCallback(snes, _cb.function, (SNES *, Vec *, Vec *, void *, PetscErrorCode *PETSC_F90_2PTR_PROTO_NOVAR), (&snes, &x, &f, _ctx, &ierr PETSC_F90_2PTR_PARAM(ptr)));
157: }
159: static PetscErrorCode oursnesobjective(SNES snes, Vec x, PetscReal *v, void *ctx)
160: {
161: #if defined(PETSC_HAVE_F90_2PTR_ARG)
162: void *ptr;
163: PetscCall(PetscObjectGetFortranCallback((PetscObject)snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.objective_pgiptr, NULL, &ptr));
164: #endif
165: PetscObjectUseFortranCallback(snes, _cb.objective, (SNES *, Vec *, PetscReal *, void *, PetscErrorCode *PETSC_F90_2PTR_PROTO_NOVAR), (&snes, &x, v, _ctx, &ierr PETSC_F90_2PTR_PARAM(ptr)));
166: }
168: static PetscErrorCode oursnestest(SNES snes, PetscInt it, PetscReal a, PetscReal d, PetscReal c, SNESConvergedReason *reason, void *ctx)
169: {
170: PetscObjectUseFortranCallback(snes, _cb.test, (SNES *, PetscInt *, PetscReal *, PetscReal *, PetscReal *, SNESConvergedReason *, void *, PetscErrorCode *), (&snes, &it, &a, &d, &c, reason, _ctx, &ierr));
171: }
173: static PetscErrorCode ourdestroy(void *ctx)
174: {
175: PetscObjectUseFortranCallback(ctx, _cb.destroy, (void *, PetscErrorCode *), (_ctx, &ierr));
176: }
178: static PetscErrorCode oursnesjacobian(SNES snes, Vec x, Mat m, Mat p, void *ctx)
179: {
180: PetscObjectUseFortranCallback(snes, _cb.jacobian, (SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&snes, &x, &m, &p, _ctx, &ierr));
181: }
183: static PetscErrorCode oursnesupdate(SNES snes, PetscInt i)
184: {
185: PetscObjectUseFortranCallback(snes, _cb.update, (SNES *, PetscInt *, PetscErrorCode *), (&snes, &i, &ierr));
186: }
187: static PetscErrorCode oursnesngs(SNES snes, Vec x, Vec b, void *ctx)
188: {
189: PetscObjectUseFortranCallback(snes, _cb.ngs, (SNES *, Vec *, Vec *, void *, PetscErrorCode *), (&snes, &x, &b, _ctx, &ierr));
190: }
191: static PetscErrorCode oursnesmonitor(SNES snes, PetscInt i, PetscReal d, void *ctx)
192: {
193: PetscObjectUseFortranCallback(snes, _cb.monitor, (SNES *, PetscInt *, PetscReal *, void *, PetscErrorCode *), (&snes, &i, &d, _ctx, &ierr));
194: }
195: static PetscErrorCode ourmondestroy(void **ctx)
196: {
197: SNES snes = (SNES)*ctx;
198: PetscObjectUseFortranCallback(snes, _cb.mondestroy, (void *, PetscErrorCode *), (_ctx, &ierr));
199: }
201: /* these are generated automatically by bfort */
202: PETSC_EXTERN void snescomputejacobiandefault_(SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *);
203: PETSC_EXTERN void snescomputejacobiandefaultcolor_(SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *);
204: PETSC_EXTERN void matmffdcomputejacobian_(SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *);
206: PETSC_EXTERN void snessetjacobian_(SNES *snes, Mat *A, Mat *B, SNESJacobianFn func, void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
207: {
208: CHKFORTRANNULLFUNCTION(func);
209: if ((PetscVoidFn *)func == (PetscVoidFn *)snescomputejacobiandefault_) {
210: *ierr = SNESSetJacobian(*snes, *A, *B, SNESComputeJacobianDefault, ctx);
211: } else if ((PetscVoidFn *)func == (PetscVoidFn *)snescomputejacobiandefaultcolor_) {
212: if (!ctx) {
213: *ierr = PETSC_ERR_ARG_NULL;
214: return;
215: }
216: *ierr = SNESSetJacobian(*snes, *A, *B, SNESComputeJacobianDefaultColor, *(MatFDColoring *)ctx);
217: } else if ((PetscVoidFn *)func == (PetscVoidFn *)matmffdcomputejacobian_) {
218: *ierr = SNESSetJacobian(*snes, *A, *B, MatMFFDComputeJacobian, ctx);
219: } else {
220: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.jacobian, (PetscVoidFn *)func, ctx);
221: if (!*ierr) *ierr = SNESSetJacobian(*snes, *A, *B, oursnesjacobian, NULL);
222: }
223: }
225: PETSC_EXTERN void snessetjacobiannointerface_(SNES *snes, Mat *A, Mat *B, SNESJacobianFn J, void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
226: {
227: snessetjacobian_(snes, A, B, J, ctx, ierr PETSC_F90_2PTR_PARAM(ptr));
228: }
230: /* func is currently ignored from Fortran */
231: PETSC_EXTERN void snesgetjacobian_(SNES *snes, Mat *A, Mat *B, int *func, void **ctx, PetscErrorCode *ierr)
232: {
233: SNESJacobianFn *jfunc;
234: void *jctx;
236: CHKFORTRANNULL(ctx);
237: CHKFORTRANNULLOBJECT(A);
238: CHKFORTRANNULLOBJECT(B);
239: *ierr = SNESGetJacobian(*snes, A, B, &jfunc, &jctx);
240: if (*ierr) return;
241: if (jfunc == SNESComputeJacobianDefault || jfunc == SNESComputeJacobianDefaultColor || jfunc == MatMFFDComputeJacobian) {
242: if (ctx) *ctx = jctx;
243: } else {
244: *ierr = PetscObjectGetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.jacobian, NULL, ctx);
245: }
246: }
248: static PetscErrorCode oursnespicardfunction(SNES snes, Vec x, Vec f, void *ctx)
249: {
250: #if defined(PETSC_HAVE_F90_2PTR_ARG)
251: void *ptr;
252: PetscCall(PetscObjectGetFortranCallback((PetscObject)snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.function_pgiptr, NULL, &ptr));
253: #endif
254: PetscObjectUseFortranCallback(snes, _cb.function, (SNES *, Vec *, Vec *, void *, PetscErrorCode *PETSC_F90_2PTR_PROTO_NOVAR), (&snes, &x, &f, _ctx, &ierr PETSC_F90_2PTR_PARAM(ptr)));
255: }
257: static PetscErrorCode oursnespicardjacobian(SNES snes, Vec x, Mat m, Mat p, void *ctx)
258: {
259: PetscObjectUseFortranCallback(snes, _cb.jacobian, (SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&snes, &x, &m, &p, _ctx, &ierr));
260: }
262: PETSC_EXTERN void snessetpicard_(SNES *snes, Vec *r, SNESFunctionFn func, Mat *A, Mat *B, SNESJacobianFn J, void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
263: {
264: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.function, (PetscVoidFn *)func, ctx);
265: #if defined(PETSC_HAVE_F90_2PTR_ARG)
266: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.function_pgiptr, NULL, ptr);
267: if (*ierr) return;
268: #endif
269: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.jacobian, (PetscVoidFn *)J, ctx);
270: if (!*ierr) *ierr = SNESSetPicard(*snes, *r, oursnespicardfunction, *A, *B, oursnespicardjacobian, NULL);
271: }
273: PETSC_EXTERN void snessetpicardnointerface_(SNES *snes, Vec *r, SNESFunctionFn func, Mat *A, Mat *B, SNESJacobianFn J, void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
274: {
275: snessetpicard_(snes, r, func, A, B, J, ctx, ierr PETSC_F90_2PTR_PARAM(ptr));
276: }
278: /*
279: These are not usually called from Fortran but allow Fortran users
280: to transparently set these monitors from .F code
281: */
283: PETSC_EXTERN void snessetfunction_(SNES *snes, Vec *r, SNESFunctionFn func, void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
284: {
285: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.function, (PetscVoidFn *)func, ctx);
286: if (*ierr) return;
287: #if defined(PETSC_HAVE_F90_2PTR_ARG)
288: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.function_pgiptr, NULL, ptr);
289: if (*ierr) return;
290: #endif
291: *ierr = SNESSetFunction(*snes, *r, oursnesfunction, NULL);
292: }
294: PETSC_EXTERN void snessetfunctionnointerface_(SNES *snes, Vec *r, SNESFunctionFn func, void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
295: {
296: snessetfunction_(snes, r, func, ctx, ierr PETSC_F90_2PTR_PARAM(ptr));
297: }
299: PETSC_EXTERN void snessetobjective_(SNES *snes, SNESObjectiveFn func, void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
300: {
301: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.objective, (PetscVoidFn *)func, ctx);
302: if (*ierr) return;
303: #if defined(PETSC_HAVE_F90_2PTR_ARG)
304: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.objective_pgiptr, NULL, ptr);
305: if (*ierr) return;
306: #endif
307: *ierr = SNESSetObjective(*snes, oursnesobjective, NULL);
308: }
310: PETSC_EXTERN void snessetobjectivenointerface_(SNES *snes, SNESObjectiveFn func, void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
311: {
312: snessetobjective_(snes, func, ctx, ierr PETSC_F90_2PTR_PARAM(ptr));
313: }
315: PETSC_EXTERN void snessetngs_(SNES *snes, void (*func)(SNES *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
316: {
317: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.ngs, (PetscVoidFn *)func, ctx);
318: if (*ierr) return;
319: *ierr = SNESSetNGS(*snes, oursnesngs, NULL);
320: }
321: PETSC_EXTERN void snessetupdate_(SNES *snes, void (*func)(SNES *, PetscInt *, PetscErrorCode *), PetscErrorCode *ierr)
322: {
323: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.update, (PetscVoidFn *)func, NULL);
324: if (*ierr) return;
325: *ierr = SNESSetUpdate(*snes, oursnesupdate);
326: }
328: /* the func argument is ignored */
329: PETSC_EXTERN void snesgetfunction_(SNES *snes, Vec *r, SNESFunctionFn func, void **ctx, PetscErrorCode *ierr)
330: {
331: CHKFORTRANNULLOBJECT(r);
332: *ierr = SNESGetFunction(*snes, r, NULL, NULL);
333: if (*ierr) return;
334: if ((PetscVoidFn *)func == (PetscVoidFn *)PETSC_NULL_FUNCTION_Fortran) return;
335: *ierr = PetscObjectGetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.function, NULL, ctx);
336: }
338: PETSC_EXTERN void snesgetngs_(SNES *snes, void *func, void **ctx, PetscErrorCode *ierr)
339: {
340: *ierr = PetscObjectGetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.ngs, NULL, ctx);
341: }
343: PETSC_EXTERN void snesconvergeddefault_(SNES *snes, PetscInt *it, PetscReal *a, PetscReal *b, PetscReal *c, SNESConvergedReason *r, void *ct, PetscErrorCode *ierr)
344: {
345: *ierr = SNESConvergedDefault(*snes, *it, *a, *b, *c, r, ct);
346: }
348: PETSC_EXTERN void snesconvergedskip_(SNES *snes, PetscInt *it, PetscReal *a, PetscReal *b, PetscReal *c, SNESConvergedReason *r, void *ct, PetscErrorCode *ierr)
349: {
350: *ierr = SNESConvergedSkip(*snes, *it, *a, *b, *c, r, ct);
351: }
353: PETSC_EXTERN void snessetconvergencetest_(SNES *snes, void (*func)(SNES *, PetscInt *, PetscReal *, PetscReal *, PetscReal *, SNESConvergedReason *, void *, PetscErrorCode *), void *cctx, void (*destroy)(void *), PetscErrorCode *ierr)
354: {
355: CHKFORTRANNULLFUNCTION(destroy);
357: if ((PetscVoidFn *)func == (PetscVoidFn *)snesconvergeddefault_) {
358: *ierr = SNESSetConvergenceTest(*snes, SNESConvergedDefault, NULL, NULL);
359: } else if ((PetscVoidFn *)func == (PetscVoidFn *)snesconvergedskip_) {
360: *ierr = SNESSetConvergenceTest(*snes, SNESConvergedSkip, NULL, NULL);
361: } else {
362: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.test, (PetscVoidFn *)func, cctx);
363: if (*ierr) return;
364: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.destroy, (PetscVoidFn *)destroy, cctx);
365: if (*ierr) return;
366: *ierr = SNESSetConvergenceTest(*snes, oursnestest, *snes, ourdestroy);
367: }
368: }
370: PETSC_EXTERN void snesgetconvergencehistory_(SNES *snes, PetscInt *na, PetscErrorCode *ierr)
371: {
372: *ierr = SNESGetConvergenceHistory(*snes, NULL, NULL, na);
373: }
375: PETSC_EXTERN void snesmonitordefault_(SNES *snes, PetscInt *its, PetscReal *fgnorm, PetscViewerAndFormat **dummy, PetscErrorCode *ierr)
376: {
377: *ierr = SNESMonitorDefault(*snes, *its, *fgnorm, *dummy);
378: }
380: PETSC_EXTERN void snesmonitorsolution_(SNES *snes, PetscInt *its, PetscReal *fgnorm, PetscViewerAndFormat **dummy, PetscErrorCode *ierr)
381: {
382: *ierr = SNESMonitorSolution(*snes, *its, *fgnorm, *dummy);
383: }
385: PETSC_EXTERN void snesmonitorsolutionupdate_(SNES *snes, PetscInt *its, PetscReal *fgnorm, PetscViewerAndFormat **dummy, PetscErrorCode *ierr)
386: {
387: *ierr = SNESMonitorSolutionUpdate(*snes, *its, *fgnorm, *dummy);
388: }
390: PETSC_EXTERN void snesmonitorset_(SNES *snes, void (*func)(SNES *, PetscInt *, PetscReal *, void *, PetscErrorCode *), void *mctx, void (*mondestroy)(void *, PetscErrorCode *), PetscErrorCode *ierr)
391: {
392: CHKFORTRANNULLFUNCTION(mondestroy);
393: if ((PetscVoidFn *)func == (PetscVoidFn *)snesmonitordefault_) {
394: *ierr = SNESMonitorSet(*snes, (PetscErrorCode (*)(SNES, PetscInt, PetscReal, void *))SNESMonitorDefault, *(PetscViewerAndFormat **)mctx, (PetscErrorCode (*)(void **))PetscViewerAndFormatDestroy);
395: } else if ((PetscVoidFn *)func == (PetscVoidFn *)snesmonitorsolution_) {
396: *ierr = SNESMonitorSet(*snes, (PetscErrorCode (*)(SNES, PetscInt, PetscReal, void *))SNESMonitorSolution, *(PetscViewerAndFormat **)mctx, (PetscErrorCode (*)(void **))PetscViewerAndFormatDestroy);
397: } else if ((PetscVoidFn *)func == (PetscVoidFn *)snesmonitorsolutionupdate_) {
398: *ierr = SNESMonitorSet(*snes, (PetscErrorCode (*)(SNES, PetscInt, PetscReal, void *))SNESMonitorSolutionUpdate, *(PetscViewerAndFormat **)mctx, (PetscErrorCode (*)(void **))PetscViewerAndFormatDestroy);
399: } else {
400: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.monitor, (PetscVoidFn *)func, mctx);
401: if (*ierr) return;
402: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.mondestroy, (PetscVoidFn *)mondestroy, mctx);
403: if (*ierr) return;
404: *ierr = SNESMonitorSet(*snes, oursnesmonitor, *snes, ourmondestroy);
405: }
406: }