Actual source code: zsnesf.c
1: #include <petsc/private/ftnimpl.h>
2: #include <petscsnes.h>
3: #include <petscviewer.h>
4: #include <petsc/private/ftnimpl.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 snesgetjacobian_ SNESGETJACOBIAN
26: #define snesmonitordefault_ SNESMONITORDEFAULT
27: #define snesmonitorsolution_ SNESMONITORSOLUTION
28: #define snesmonitorsolutionupdate_ SNESMONITORSOLUTIONUPDATE
29: #define snesmonitorset_ SNESMONITORSET
30: #define snesnewtontrsetprecheck_ SNESNEWTONTRSETPRECHECK
31: #define snesnewtontrsetpostcheck_ SNESNEWTONTRSETPOSTCHECK
32: #define snesnewtontrdcsetprecheck_ SNESNEWTONTRDCSETPRECHECK
33: #define snesnewtontrdcsetpostcheck_ SNESNEWTONTRDCSETPOSTCHECK
34: #define matmffdcomputejacobian_ MATMFFDCOMPUTEJACOBIAN
35: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
36: #define snessetpicard_ snessetpicard
37: #define snessetpicardnointerface_ snessetpicardnointerface
38: #define snessolve_ snessolve
39: #define snescomputejacobiandefault_ snescomputejacobiandefault
40: #define snescomputejacobiandefaultcolor_ snescomputejacobiandefaultcolor
41: #define snessetjacobian_ snessetjacobian
42: #define snessetjacobiannointerface_ snessetjacobiannointerface
43: #define snessetfunction_ snessetfunction
44: #define snessetfunctionnointerface_ snessetfunctionnointerface
45: #define snessetobjective_ snessetobjective
46: #define snessetobjectivenointerface_ snessetobjectivenointerface
47: #define snessetngs_ snessetngs
48: #define snessetupdate_ snessetupdate
49: #define snesgetfunction_ snesgetfunction
50: #define snesgetngs_ snesgetngs
51: #define snessetconvergencetest_ snessetconvergencetest
52: #define snesconvergeddefault_ snesconvergeddefault
53: #define snesconvergedskip_ snesconvergedskip
54: #define snesgetjacobian_ snesgetjacobian
55: #define snesmonitordefault_ snesmonitordefault
56: #define snesmonitorsolution_ snesmonitorsolution
57: #define snesmonitorsolutionupdate_ snesmonitorsolutionupdate
58: #define snesmonitorset_ snesmonitorset
59: #define snesnewtontrsetprecheck_ snesnewtontrsetprecheck
60: #define snesnewtontrsetpostcheck_ snesnewtontrsetpostcheck
61: #define snesnewtontrdcsetprecheck_ snesnewtontrdcsetprecheck
62: #define snesnewtontrdcsetpostcheck_ snesnewtontrdcsetpostcheck
63: #define matmffdcomputejacobian_ matmffdcomputejacobian
64: #endif
66: static struct {
67: PetscFortranCallbackId function;
68: PetscFortranCallbackId objective;
69: PetscFortranCallbackId test;
70: PetscFortranCallbackId destroy;
71: PetscFortranCallbackId jacobian;
72: PetscFortranCallbackId monitor;
73: PetscFortranCallbackId mondestroy;
74: PetscFortranCallbackId ngs;
75: PetscFortranCallbackId update;
76: PetscFortranCallbackId trprecheck;
77: PetscFortranCallbackId trpostcheck;
78: #if defined(PETSC_HAVE_F90_2PTR_ARG)
79: PetscFortranCallbackId function_pgiptr;
80: PetscFortranCallbackId objective_pgiptr;
81: PetscFortranCallbackId trprecheck_pgiptr;
82: PetscFortranCallbackId trpostcheck_pgiptr;
83: #endif
84: } _cb;
86: static PetscErrorCode ourtrprecheckfunction(SNES snes, Vec x, Vec y, PetscBool *changed_y, void *ctx)
87: {
88: #if defined(PETSC_HAVE_F90_2PTR_ARG)
89: void *ptr;
90: PetscCall(PetscObjectGetFortranCallback((PetscObject)snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.trprecheck_pgiptr, NULL, &ptr));
91: #endif
92: 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)));
93: }
95: PETSC_EXTERN void snesnewtontrsetprecheck_(SNES *snes, void (*func)(SNES, Vec, Vec, PetscBool *, void *), void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
96: {
97: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trprecheck, (PetscVoidFn *)func, ctx);
98: if (*ierr) return;
99: #if defined(PETSC_HAVE_F90_2PTR_ARG)
100: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trprecheck_pgiptr, NULL, ptr);
101: if (*ierr) return;
102: #endif
103: *ierr = SNESNewtonTRSetPreCheck(*snes, ourtrprecheckfunction, NULL);
104: }
106: PETSC_EXTERN void snesnewtontrdcsetprecheck_(SNES *snes, void (*func)(SNES, Vec, Vec, PetscBool *, void *), void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
107: {
108: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trprecheck, (PetscVoidFn *)func, ctx);
109: if (*ierr) return;
110: #if defined(PETSC_HAVE_F90_2PTR_ARG)
111: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trprecheck_pgiptr, NULL, ptr);
112: if (*ierr) return;
113: #endif
114: *ierr = SNESNewtonTRDCSetPreCheck(*snes, ourtrprecheckfunction, NULL);
115: }
117: static PetscErrorCode ourtrpostcheckfunction(SNES snes, Vec x, Vec y, Vec w, PetscBool *changed_y, PetscBool *changed_w, void *ctx)
118: {
119: #if defined(PETSC_HAVE_F90_2PTR_ARG)
120: void *ptr;
121: PetscCall(PetscObjectGetFortranCallback((PetscObject)snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.trpostcheck_pgiptr, NULL, &ptr));
122: #endif
123: 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)));
124: }
126: PETSC_EXTERN void snesnewtontrsetpostcheck_(SNES *snes, void (*func)(SNES, Vec, Vec, Vec, PetscBool *, PetscBool *, void *), void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
127: {
128: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trpostcheck, (PetscVoidFn *)func, ctx);
129: if (*ierr) return;
130: #if defined(PETSC_HAVE_F90_2PTR_ARG)
131: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trpostcheck_pgiptr, NULL, ptr);
132: if (*ierr) return;
133: #endif
134: *ierr = SNESNewtonTRSetPostCheck(*snes, ourtrpostcheckfunction, NULL);
135: }
137: PETSC_EXTERN void snesnewtontrdcsetpostcheck_(SNES *snes, void (*func)(SNES, Vec, Vec, Vec, PetscBool *, PetscBool *, void *), void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
138: {
139: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trpostcheck, (PetscVoidFn *)func, ctx);
140: if (*ierr) return;
141: #if defined(PETSC_HAVE_F90_2PTR_ARG)
142: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trpostcheck_pgiptr, NULL, ptr);
143: if (*ierr) return;
144: #endif
145: *ierr = SNESNewtonTRDCSetPostCheck(*snes, ourtrpostcheckfunction, NULL);
146: }
148: static PetscErrorCode oursnesfunction(SNES snes, Vec x, Vec f, void *ctx)
149: {
150: #if defined(PETSC_HAVE_F90_2PTR_ARG)
151: void *ptr;
152: PetscCall(PetscObjectGetFortranCallback((PetscObject)snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.function_pgiptr, NULL, &ptr));
153: #endif
154: PetscObjectUseFortranCallback(snes, _cb.function, (SNES *, Vec *, Vec *, void *, PetscErrorCode *PETSC_F90_2PTR_PROTO_NOVAR), (&snes, &x, &f, _ctx, &ierr PETSC_F90_2PTR_PARAM(ptr)));
155: }
157: static PetscErrorCode oursnesobjective(SNES snes, Vec x, PetscReal *v, void *ctx)
158: {
159: #if defined(PETSC_HAVE_F90_2PTR_ARG)
160: void *ptr;
161: PetscCall(PetscObjectGetFortranCallback((PetscObject)snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.objective_pgiptr, NULL, &ptr));
162: #endif
163: PetscObjectUseFortranCallback(snes, _cb.objective, (SNES *, Vec *, PetscReal *, void *, PetscErrorCode *PETSC_F90_2PTR_PROTO_NOVAR), (&snes, &x, v, _ctx, &ierr PETSC_F90_2PTR_PARAM(ptr)));
164: }
166: static PetscErrorCode oursnestest(SNES snes, PetscInt it, PetscReal a, PetscReal d, PetscReal c, SNESConvergedReason *reason, void *ctx)
167: {
168: PetscObjectUseFortranCallback(snes, _cb.test, (SNES *, PetscInt *, PetscReal *, PetscReal *, PetscReal *, SNESConvergedReason *, void *, PetscErrorCode *), (&snes, &it, &a, &d, &c, reason, _ctx, &ierr));
169: }
171: static PetscErrorCode ourdestroy(void *ctx)
172: {
173: PetscObjectUseFortranCallback(ctx, _cb.destroy, (void *, PetscErrorCode *), (_ctx, &ierr));
174: }
176: static PetscErrorCode oursnesjacobian(SNES snes, Vec x, Mat m, Mat p, void *ctx)
177: {
178: PetscObjectUseFortranCallback(snes, _cb.jacobian, (SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&snes, &x, &m, &p, _ctx, &ierr));
179: }
181: static PetscErrorCode oursnesupdate(SNES snes, PetscInt i)
182: {
183: PetscObjectUseFortranCallback(snes, _cb.update, (SNES *, PetscInt *, PetscErrorCode *), (&snes, &i, &ierr));
184: }
185: static PetscErrorCode oursnesngs(SNES snes, Vec x, Vec b, void *ctx)
186: {
187: PetscObjectUseFortranCallback(snes, _cb.ngs, (SNES *, Vec *, Vec *, void *, PetscErrorCode *), (&snes, &x, &b, _ctx, &ierr));
188: }
189: static PetscErrorCode oursnesmonitor(SNES snes, PetscInt i, PetscReal d, void *ctx)
190: {
191: PetscObjectUseFortranCallback(snes, _cb.monitor, (SNES *, PetscInt *, PetscReal *, void *, PetscErrorCode *), (&snes, &i, &d, _ctx, &ierr));
192: }
193: static PetscErrorCode ourmondestroy(void **ctx)
194: {
195: SNES snes = (SNES)*ctx;
196: PetscObjectUseFortranCallback(snes, _cb.mondestroy, (void *, PetscErrorCode *), (_ctx, &ierr));
197: }
199: PETSC_EXTERN void snescomputejacobiandefault_(SNES *a, Vec *b, Mat *c, Mat *d, void *e, PetscErrorCode *ierr) { }
200: PETSC_EXTERN void snescomputejacobiandefaultcolor_(SNES *a, Vec *b, Mat *c, Mat *d, void *e, PetscErrorCode *ierr) { }
201: PETSC_EXTERN void matmffdcomputejacobian_(SNES *a, Vec *b, Mat *c, Mat *d, void *e, PetscErrorCode *ierr);
203: PETSC_EXTERN void snessetjacobian_(SNES *snes, Mat *A, Mat *B, SNESJacobianFn func, void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
204: {
205: CHKFORTRANNULLFUNCTION(func);
206: if ((PetscVoidFn *)func == (PetscVoidFn *)snescomputejacobiandefault_) {
207: *ierr = SNESSetJacobian(*snes, *A, *B, SNESComputeJacobianDefault, ctx);
208: } else if ((PetscVoidFn *)func == (PetscVoidFn *)snescomputejacobiandefaultcolor_) {
209: if (!ctx) {
210: *ierr = PETSC_ERR_ARG_NULL;
211: return;
212: }
213: *ierr = SNESSetJacobian(*snes, *A, *B, SNESComputeJacobianDefaultColor, *(MatFDColoring *)ctx);
214: } else if ((PetscVoidFn *)func == (PetscVoidFn *)matmffdcomputejacobian_) {
215: *ierr = SNESSetJacobian(*snes, *A, *B, MatMFFDComputeJacobian, ctx);
216: } else {
217: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.jacobian, (PetscVoidFn *)func, ctx);
218: if (!*ierr) *ierr = SNESSetJacobian(*snes, *A, *B, oursnesjacobian, NULL);
219: }
220: }
222: PETSC_EXTERN void snessetjacobiannointerface_(SNES *snes, Mat *A, Mat *B, SNESJacobianFn J, void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
223: {
224: snessetjacobian_(snes, A, B, J, ctx, ierr PETSC_F90_2PTR_PARAM(ptr));
225: }
227: /* func is currently ignored from Fortran */
228: PETSC_EXTERN void snesgetjacobian_(SNES *snes, Mat *A, Mat *B, int *func, void **ctx, PetscErrorCode *ierr)
229: {
230: SNESJacobianFn *jfunc;
231: void *jctx;
233: CHKFORTRANNULL(ctx);
234: CHKFORTRANNULLOBJECT(A);
235: CHKFORTRANNULLOBJECT(B);
236: *ierr = SNESGetJacobian(*snes, A, B, &jfunc, &jctx);
237: if (*ierr) return;
238: if (jfunc == SNESComputeJacobianDefault || jfunc == SNESComputeJacobianDefaultColor || jfunc == MatMFFDComputeJacobian) {
239: if (ctx) *ctx = jctx;
240: } else {
241: *ierr = PetscObjectGetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.jacobian, NULL, ctx);
242: }
243: }
245: static PetscErrorCode oursnespicardfunction(SNES snes, Vec x, Vec f, void *ctx)
246: {
247: #if defined(PETSC_HAVE_F90_2PTR_ARG)
248: void *ptr;
249: PetscCall(PetscObjectGetFortranCallback((PetscObject)snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.function_pgiptr, NULL, &ptr));
250: #endif
251: PetscObjectUseFortranCallback(snes, _cb.function, (SNES *, Vec *, Vec *, void *, PetscErrorCode *PETSC_F90_2PTR_PROTO_NOVAR), (&snes, &x, &f, _ctx, &ierr PETSC_F90_2PTR_PARAM(ptr)));
252: }
254: static PetscErrorCode oursnespicardjacobian(SNES snes, Vec x, Mat m, Mat p, void *ctx)
255: {
256: PetscObjectUseFortranCallback(snes, _cb.jacobian, (SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&snes, &x, &m, &p, _ctx, &ierr));
257: }
259: 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))
260: {
261: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.function, (PetscVoidFn *)func, ctx);
262: #if defined(PETSC_HAVE_F90_2PTR_ARG)
263: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.function_pgiptr, NULL, ptr);
264: if (*ierr) return;
265: #endif
266: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.jacobian, (PetscVoidFn *)J, ctx);
267: if (!*ierr) *ierr = SNESSetPicard(*snes, *r, oursnespicardfunction, *A, *B, oursnespicardjacobian, NULL);
268: }
270: 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))
271: {
272: snessetpicard_(snes, r, func, A, B, J, ctx, ierr PETSC_F90_2PTR_PARAM(ptr));
273: }
275: /*
276: These are not usually called from Fortran but allow Fortran users
277: to transparently set these monitors from .F code
278: */
280: PETSC_EXTERN void snessetfunction_(SNES *snes, Vec *r, SNESFunctionFn func, void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
281: {
282: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.function, (PetscVoidFn *)func, ctx);
283: if (*ierr) return;
284: #if defined(PETSC_HAVE_F90_2PTR_ARG)
285: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.function_pgiptr, NULL, ptr);
286: if (*ierr) return;
287: #endif
288: *ierr = SNESSetFunction(*snes, *r, oursnesfunction, NULL);
289: }
291: PETSC_EXTERN void snessetfunctionnointerface_(SNES *snes, Vec *r, SNESFunctionFn func, void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
292: {
293: snessetfunction_(snes, r, func, ctx, ierr PETSC_F90_2PTR_PARAM(ptr));
294: }
296: PETSC_EXTERN void snessetobjective_(SNES *snes, SNESObjectiveFn func, void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
297: {
298: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.objective, (PetscVoidFn *)func, ctx);
299: if (*ierr) return;
300: #if defined(PETSC_HAVE_F90_2PTR_ARG)
301: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.objective_pgiptr, NULL, ptr);
302: if (*ierr) return;
303: #endif
304: *ierr = SNESSetObjective(*snes, oursnesobjective, NULL);
305: }
307: PETSC_EXTERN void snessetobjectivenointerface_(SNES *snes, SNESObjectiveFn func, void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
308: {
309: snessetobjective_(snes, func, ctx, ierr PETSC_F90_2PTR_PARAM(ptr));
310: }
312: PETSC_EXTERN void snessetngs_(SNES *snes, void (*func)(SNES *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
313: {
314: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.ngs, (PetscVoidFn *)func, ctx);
315: if (*ierr) return;
316: *ierr = SNESSetNGS(*snes, oursnesngs, NULL);
317: }
318: PETSC_EXTERN void snessetupdate_(SNES *snes, void (*func)(SNES *, PetscInt *, PetscErrorCode *), PetscErrorCode *ierr)
319: {
320: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.update, (PetscVoidFn *)func, NULL);
321: if (*ierr) return;
322: *ierr = SNESSetUpdate(*snes, oursnesupdate);
323: }
325: /* the func argument is ignored */
326: PETSC_EXTERN void snesgetfunction_(SNES *snes, Vec *r, SNESFunctionFn func, void **ctx, PetscErrorCode *ierr)
327: {
328: CHKFORTRANNULLOBJECT(r);
329: *ierr = SNESGetFunction(*snes, r, NULL, NULL);
330: if (*ierr) return;
331: if ((PetscVoidFn *)func == (PetscVoidFn *)PETSC_NULL_FUNCTION_Fortran) return;
332: *ierr = PetscObjectGetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.function, NULL, ctx);
333: }
335: PETSC_EXTERN void snesgetngs_(SNES *snes, void *func, void **ctx, PetscErrorCode *ierr)
336: {
337: *ierr = PetscObjectGetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.ngs, NULL, ctx);
338: }
340: PETSC_EXTERN void snesconvergeddefault_(SNES *, PetscInt *, PetscReal *, PetscReal *, PetscReal *, SNESConvergedReason *, void *, PetscErrorCode *);
341: PETSC_EXTERN void snesconvergedskip_(SNES, PetscInt *, PetscReal *, PetscReal *, PetscReal *, SNESConvergedReason *, void *, PetscErrorCode *);
343: PETSC_EXTERN void snessetconvergencetest_(SNES *snes, void (*func)(SNES *, PetscInt *, PetscReal *, PetscReal *, PetscReal *, SNESConvergedReason *, void *, PetscErrorCode *), void *cctx, void (*destroy)(void *), PetscErrorCode *ierr)
344: {
345: CHKFORTRANNULLFUNCTION(destroy);
347: if ((PetscVoidFn *)func == (PetscVoidFn *)snesconvergeddefault_) {
348: *ierr = SNESSetConvergenceTest(*snes, SNESConvergedDefault, NULL, NULL);
349: } else if ((PetscVoidFn *)func == (PetscVoidFn *)snesconvergedskip_) {
350: *ierr = SNESSetConvergenceTest(*snes, SNESConvergedSkip, NULL, NULL);
351: } else {
352: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.test, (PetscVoidFn *)func, cctx);
353: if (*ierr) return;
354: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.destroy, (PetscVoidFn *)destroy, cctx);
355: if (*ierr) return;
356: *ierr = SNESSetConvergenceTest(*snes, oursnestest, *snes, ourdestroy);
357: }
358: }
360: PETSC_EXTERN void snesmonitordefault_(SNES *, PetscInt *, PetscReal *, PetscViewerAndFormat **, PetscErrorCode *);
362: PETSC_EXTERN void snesmonitorsolution_(SNES *snes, PetscInt *its, PetscReal *fgnorm, PetscViewerAndFormat **dummy, PetscErrorCode *ierr);
364: PETSC_EXTERN void snesmonitorsolutionupdate_(SNES *snes, PetscInt *its, PetscReal *fgnorm, PetscViewerAndFormat **dummy, PetscErrorCode *ierr);
366: PETSC_EXTERN void snesmonitorset_(SNES *snes, void (*func)(SNES *, PetscInt *, PetscReal *, void *, PetscErrorCode *), void *mctx, void (*mondestroy)(void *, PetscErrorCode *), PetscErrorCode *ierr)
367: {
368: CHKFORTRANNULLFUNCTION(mondestroy);
369: if ((PetscVoidFn *)func == (PetscVoidFn *)snesmonitordefault_) {
370: *ierr = SNESMonitorSet(*snes, (PetscErrorCode (*)(SNES, PetscInt, PetscReal, void *))SNESMonitorDefault, *(PetscViewerAndFormat **)mctx, (PetscCtxDestroyFn *)PetscViewerAndFormatDestroy);
371: } else if ((PetscVoidFn *)func == (PetscVoidFn *)snesmonitorsolution_) {
372: *ierr = SNESMonitorSet(*snes, (PetscErrorCode (*)(SNES, PetscInt, PetscReal, void *))SNESMonitorSolution, *(PetscViewerAndFormat **)mctx, (PetscCtxDestroyFn *)PetscViewerAndFormatDestroy);
373: } else if ((PetscVoidFn *)func == (PetscVoidFn *)snesmonitorsolutionupdate_) {
374: *ierr = SNESMonitorSet(*snes, (PetscErrorCode (*)(SNES, PetscInt, PetscReal, void *))SNESMonitorSolutionUpdate, *(PetscViewerAndFormat **)mctx, (PetscCtxDestroyFn *)PetscViewerAndFormatDestroy);
375: } else {
376: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.monitor, (PetscVoidFn *)func, mctx);
377: if (*ierr) return;
378: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.mondestroy, (PetscVoidFn *)mondestroy, mctx);
379: if (*ierr) return;
380: *ierr = SNESMonitorSet(*snes, oursnesmonitor, *snes, ourmondestroy);
381: }
382: }