Actual source code: zsnesf.c
1: #include <petsc/private/ftnimpl.h>
2: #include <petscsnes.h>
3: #include <petsc/private/ftnimpl.h>
5: #if PetscDefined(HAVE_FORTRAN_CAPS)
6: #define snessetpicard_ SNESSETPICARD
7: #define snessetpicardnointerface_ SNESSETPICARDNOINTERFACE
8: #define snessolve_ SNESSOLVE
9: #define snescomputejacobiandefault_ SNESCOMPUTEJACOBIANDEFAULT
10: #define snescomputejacobiandefaultcolor_ SNESCOMPUTEJACOBIANDEFAULTCOLOR
11: #define snessetjacobian_ SNESSETJACOBIAN
12: #define snessetjacobiannointerface_ SNESSETJACOBIANNOINTERFACE
13: #define snessetfunction_ SNESSETFUNCTION
14: #define snessetfunctionnointerface_ SNESSETFUNCTIONNOINTERFACE
15: #define snessetobjective_ SNESSETOBJECTIVE
16: #define snessetobjectivenointerface_ SNESSETOBJECTIVENOINTERFACE
17: #define snessetngs_ SNESSETNGS
18: #define snessetupdate_ SNESSETUPDATE
19: #define snesgetfunction_ SNESGETFUNCTION
20: #define snesgetngs_ SNESGETNGS
21: #define snessetconvergencetest_ SNESSETCONVERGENCETEST
22: #define snesconvergeddefault_ SNESCONVERGEDDEFAULT
23: #define snesconvergedskip_ SNESCONVERGEDSKIP
24: #define snesgetjacobian_ SNESGETJACOBIAN
25: #define snesmonitordefault_ SNESMONITORDEFAULT
26: #define snesmonitorsolution_ SNESMONITORSOLUTION
27: #define snesmonitorsolutionupdate_ SNESMONITORSOLUTIONUPDATE
28: #define snesmonitorset_ SNESMONITORSET
29: #define snesnewtontrsetprecheck_ SNESNEWTONTRSETPRECHECK
30: #define snesnewtontrsetpostcheck_ SNESNEWTONTRSETPOSTCHECK
31: #define snesnewtontrdcsetprecheck_ SNESNEWTONTRDCSETPRECHECK
32: #define snesnewtontrdcsetpostcheck_ SNESNEWTONTRDCSETPOSTCHECK
33: #define matmffdcomputejacobian_ MATMFFDCOMPUTEJACOBIAN
34: #elif !PetscDefined(HAVE_FORTRAN_UNDERSCORE)
35: #define snessetpicard_ snessetpicard
36: #define snessetpicardnointerface_ snessetpicardnointerface
37: #define snessolve_ snessolve
38: #define snescomputejacobiandefault_ snescomputejacobiandefault
39: #define snescomputejacobiandefaultcolor_ snescomputejacobiandefaultcolor
40: #define snessetjacobian_ snessetjacobian
41: #define snessetjacobiannointerface_ snessetjacobiannointerface
42: #define snessetfunction_ snessetfunction
43: #define snessetfunctionnointerface_ snessetfunctionnointerface
44: #define snessetobjective_ snessetobjective
45: #define snessetobjectivenointerface_ snessetobjectivenointerface
46: #define snessetngs_ snessetngs
47: #define snessetupdate_ snessetupdate
48: #define snesgetfunction_ snesgetfunction
49: #define snesgetngs_ snesgetngs
50: #define snessetconvergencetest_ snessetconvergencetest
51: #define snesconvergeddefault_ snesconvergeddefault
52: #define snesconvergedskip_ snesconvergedskip
53: #define snesgetjacobian_ snesgetjacobian
54: #define snesmonitordefault_ snesmonitordefault
55: #define snesmonitorsolution_ snesmonitorsolution
56: #define snesmonitorsolutionupdate_ snesmonitorsolutionupdate
57: #define snesmonitorset_ snesmonitorset
58: #define snesnewtontrsetprecheck_ snesnewtontrsetprecheck
59: #define snesnewtontrsetpostcheck_ snesnewtontrsetpostcheck
60: #define snesnewtontrdcsetprecheck_ snesnewtontrdcsetprecheck
61: #define snesnewtontrdcsetpostcheck_ snesnewtontrdcsetpostcheck
62: #define matmffdcomputejacobian_ matmffdcomputejacobian
63: #endif
65: static struct {
66: PetscFortranCallbackId function;
67: PetscFortranCallbackId objective;
68: PetscFortranCallbackId test;
69: PetscFortranCallbackId destroy;
70: PetscFortranCallbackId jacobian;
71: PetscFortranCallbackId monitor;
72: PetscFortranCallbackId mondestroy;
73: PetscFortranCallbackId ngs;
74: PetscFortranCallbackId update;
75: PetscFortranCallbackId trprecheck;
76: PetscFortranCallbackId trpostcheck;
77: #if PetscDefined(HAVE_F90_2PTR_ARG)
78: PetscFortranCallbackId function_pgiptr;
79: PetscFortranCallbackId objective_pgiptr;
80: PetscFortranCallbackId trprecheck_pgiptr;
81: PetscFortranCallbackId trpostcheck_pgiptr;
82: #endif
83: } _cb;
85: static PetscErrorCode ourtrprecheckfunction(SNES snes, Vec x, Vec y, PetscBool *changed_y, PetscCtx ctx)
86: {
87: #if PetscDefined(HAVE_F90_2PTR_ARG)
88: void *ptr;
89: PetscCall(PetscObjectGetFortranCallback((PetscObject)snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.trprecheck_pgiptr, NULL, &ptr));
90: #endif
91: 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)));
92: }
94: PETSC_EXTERN void snesnewtontrsetprecheck_(SNES *snes, void (*func)(SNES, Vec, Vec, PetscBool *, void *), PetscCtx ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
95: {
96: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trprecheck, (PetscFortranCallbackFn *)func, ctx);
97: if (*ierr) return;
98: #if PetscDefined(HAVE_F90_2PTR_ARG)
99: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trprecheck_pgiptr, NULL, ptr);
100: if (*ierr) return;
101: #endif
102: *ierr = SNESNewtonTRSetPreCheck(*snes, ourtrprecheckfunction, NULL);
103: }
105: PETSC_EXTERN void snesnewtontrdcsetprecheck_(SNES *snes, void (*func)(SNES, Vec, Vec, PetscBool *, void *), PetscCtx ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
106: {
107: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trprecheck, (PetscFortranCallbackFn *)func, ctx);
108: if (*ierr) return;
109: #if PetscDefined(HAVE_F90_2PTR_ARG)
110: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trprecheck_pgiptr, NULL, ptr);
111: if (*ierr) return;
112: #endif
113: *ierr = SNESNewtonTRDCSetPreCheck(*snes, ourtrprecheckfunction, NULL);
114: }
116: static PetscErrorCode ourtrpostcheckfunction(SNES snes, Vec x, Vec y, Vec w, PetscBool *changed_y, PetscBool *changed_w, PetscCtx ctx)
117: {
118: #if PetscDefined(HAVE_F90_2PTR_ARG)
119: void *ptr;
120: PetscCall(PetscObjectGetFortranCallback((PetscObject)snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.trpostcheck_pgiptr, NULL, &ptr));
121: #endif
122: 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)));
123: }
125: PETSC_EXTERN void snesnewtontrsetpostcheck_(SNES *snes, void (*func)(SNES, Vec, Vec, Vec, PetscBool *, PetscBool *, void *), PetscCtx ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
126: {
127: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trpostcheck, (PetscFortranCallbackFn *)func, ctx);
128: if (*ierr) return;
129: #if PetscDefined(HAVE_F90_2PTR_ARG)
130: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trpostcheck_pgiptr, NULL, ptr);
131: if (*ierr) return;
132: #endif
133: *ierr = SNESNewtonTRSetPostCheck(*snes, ourtrpostcheckfunction, NULL);
134: }
136: PETSC_EXTERN void snesnewtontrdcsetpostcheck_(SNES *snes, void (*func)(SNES, Vec, Vec, Vec, PetscBool *, PetscBool *, void *), PetscCtx ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
137: {
138: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trpostcheck, (PetscFortranCallbackFn *)func, ctx);
139: if (*ierr) return;
140: #if PetscDefined(HAVE_F90_2PTR_ARG)
141: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trpostcheck_pgiptr, NULL, ptr);
142: if (*ierr) return;
143: #endif
144: *ierr = SNESNewtonTRDCSetPostCheck(*snes, ourtrpostcheckfunction, NULL);
145: }
147: static PetscErrorCode oursnesfunction(SNES snes, Vec x, Vec f, PetscCtx ctx)
148: {
149: #if PetscDefined(HAVE_F90_2PTR_ARG)
150: void *ptr;
151: PetscCall(PetscObjectGetFortranCallback((PetscObject)snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.function_pgiptr, NULL, &ptr));
152: #endif
153: PetscObjectUseFortranCallback(snes, _cb.function, (SNES *, Vec *, Vec *, void *, PetscErrorCode *PETSC_F90_2PTR_PROTO_NOVAR), (&snes, &x, &f, _ctx, &ierr PETSC_F90_2PTR_PARAM(ptr)));
154: }
156: static PetscErrorCode oursnesobjective(SNES snes, Vec x, PetscReal *v, PetscCtx ctx)
157: {
158: #if PetscDefined(HAVE_F90_2PTR_ARG)
159: void *ptr;
160: PetscCall(PetscObjectGetFortranCallback((PetscObject)snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.objective_pgiptr, NULL, &ptr));
161: #endif
162: PetscObjectUseFortranCallback(snes, _cb.objective, (SNES *, Vec *, PetscReal *, void *, PetscErrorCode *PETSC_F90_2PTR_PROTO_NOVAR), (&snes, &x, v, _ctx, &ierr PETSC_F90_2PTR_PARAM(ptr)));
163: }
165: static PetscErrorCode oursnestest(SNES snes, PetscInt it, PetscReal a, PetscReal d, PetscReal c, SNESConvergedReason *reason, PetscCtx ctx)
166: {
167: PetscObjectUseFortranCallback(snes, _cb.test, (SNES *, PetscInt *, PetscReal *, PetscReal *, PetscReal *, SNESConvergedReason *, void *, PetscErrorCode *), (&snes, &it, &a, &d, &c, reason, _ctx, &ierr));
168: }
170: static PetscErrorCode ourdestroy(PetscCtxRt ctx)
171: {
172: PetscObjectUseFortranCallback(ctx, _cb.destroy, (void *, PetscErrorCode *), (_ctx, &ierr));
173: }
175: static PetscErrorCode oursnesjacobian(SNES snes, Vec x, Mat m, Mat p, PetscCtx ctx)
176: {
177: PetscObjectUseFortranCallback(snes, _cb.jacobian, (SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&snes, &x, &m, &p, _ctx, &ierr));
178: }
180: static PetscErrorCode oursnesupdate(SNES snes, PetscInt i)
181: {
182: PetscObjectUseFortranCallback(snes, _cb.update, (SNES *, PetscInt *, PetscErrorCode *), (&snes, &i, &ierr));
183: }
184: static PetscErrorCode oursnesngs(SNES snes, Vec x, Vec b, PetscCtx ctx)
185: {
186: PetscObjectUseFortranCallback(snes, _cb.ngs, (SNES *, Vec *, Vec *, void *, PetscErrorCode *), (&snes, &x, &b, _ctx, &ierr));
187: }
188: static PetscErrorCode oursnesmonitor(SNES snes, PetscInt i, PetscReal d, PetscCtx ctx)
189: {
190: PetscObjectUseFortranCallback(snes, _cb.monitor, (SNES *, PetscInt *, PetscReal *, void *, PetscErrorCode *), (&snes, &i, &d, _ctx, &ierr));
191: }
192: static PetscErrorCode ourmondestroy(PetscCtxRt ctx)
193: {
194: SNES snes = *(SNES *)ctx;
195: PetscObjectUseFortranCallback(snes, _cb.mondestroy, (void *, PetscErrorCode *), (_ctx, &ierr));
196: }
198: PETSC_EXTERN void snescomputejacobiandefault_(SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *);
199: PETSC_EXTERN void snescomputejacobiandefaultcolor_(SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *);
200: PETSC_EXTERN void matmffdcomputejacobian_(SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *);
202: PETSC_EXTERN void snessetjacobian_(SNES *snes, Mat *Amat, Mat *Pmat, void (*func)(SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), PetscCtx ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
203: {
204: CHKFORTRANNULLFUNCTION(func);
205: if (func == snescomputejacobiandefault_) {
206: *ierr = SNESSetJacobian(*snes, *Amat, *Pmat, SNESComputeJacobianDefault, ctx);
207: } else if (func == snescomputejacobiandefaultcolor_) {
208: if (!ctx) {
209: *ierr = PETSC_ERR_ARG_NULL;
210: return;
211: }
212: *ierr = SNESSetJacobian(*snes, *Amat, *Pmat, SNESComputeJacobianDefaultColor, *(MatFDColoring *)ctx);
213: } else if (func == matmffdcomputejacobian_) {
214: *ierr = SNESSetJacobian(*snes, *Amat, *Pmat, MatMFFDComputeJacobian, ctx);
215: } else {
216: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.jacobian, (PetscFortranCallbackFn *)func, ctx);
217: if (!*ierr) *ierr = SNESSetJacobian(*snes, *Amat, *Pmat, oursnesjacobian, NULL);
218: }
219: }
221: PETSC_EXTERN void snessetjacobiannointerface_(SNES *snes, Mat *Amat, Mat *Pmat, void (*func)(SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), PetscCtx ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
222: {
223: snessetjacobian_(snes, Amat, Pmat, func, ctx, ierr PETSC_F90_2PTR_PARAM(ptr));
224: }
226: /* func is currently ignored from Fortran */
227: PETSC_EXTERN void snesgetjacobian_(SNES *snes, Mat *Amat, Mat *Pmat, int *func, void **ctx, PetscErrorCode *ierr)
228: {
229: SNESJacobianFn *jfunc;
230: void *jctx;
232: CHKFORTRANNULL(ctx);
233: CHKFORTRANNULLOBJECT(Amat);
234: CHKFORTRANNULLOBJECT(Pmat);
235: *ierr = SNESGetJacobian(*snes, Amat, Pmat, &jfunc, &jctx);
236: if (*ierr) return;
237: if (jfunc == SNESComputeJacobianDefault || jfunc == SNESComputeJacobianDefaultColor || jfunc == MatMFFDComputeJacobian) {
238: if (ctx) *ctx = jctx;
239: } else {
240: *ierr = PetscObjectGetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.jacobian, NULL, ctx);
241: }
242: }
244: static PetscErrorCode oursnespicardfunction(SNES snes, Vec x, Vec f, PetscCtx ctx)
245: {
246: #if PetscDefined(HAVE_F90_2PTR_ARG)
247: void *ptr;
248: PetscCall(PetscObjectGetFortranCallback((PetscObject)snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.function_pgiptr, NULL, &ptr));
249: #endif
250: PetscObjectUseFortranCallback(snes, _cb.function, (SNES *, Vec *, Vec *, void *, PetscErrorCode *PETSC_F90_2PTR_PROTO_NOVAR), (&snes, &x, &f, _ctx, &ierr PETSC_F90_2PTR_PARAM(ptr)));
251: }
253: static PetscErrorCode oursnespicardjacobian(SNES snes, Vec x, Mat m, Mat p, PetscCtx ctx)
254: {
255: PetscObjectUseFortranCallback(snes, _cb.jacobian, (SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&snes, &x, &m, &p, _ctx, &ierr));
256: }
258: PETSC_EXTERN void snessetpicard_(SNES *snes, Vec *r, void (*func)(SNES, Vec, Vec, void *, PetscErrorCode *), Mat *Amat, Mat *Pmat, void (*J)(SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), PetscCtx ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
259: {
260: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.function, (PetscFortranCallbackFn *)func, ctx);
261: #if PetscDefined(HAVE_F90_2PTR_ARG)
262: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.function_pgiptr, NULL, ptr);
263: if (*ierr) return;
264: #endif
265: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.jacobian, (PetscFortranCallbackFn *)J, ctx);
266: if (!*ierr) *ierr = SNESSetPicard(*snes, *r, oursnespicardfunction, *Amat, *Pmat, oursnespicardjacobian, NULL);
267: }
269: PETSC_EXTERN void snessetpicardnointerface_(SNES *snes, Vec *r, void (*func)(SNES, Vec, Vec, void *, PetscErrorCode *), Mat *Amat, Mat *Pmat, void (*J)(SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), PetscCtx ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
270: {
271: snessetpicard_(snes, r, func, Amat, Pmat, J, ctx, ierr PETSC_F90_2PTR_PARAM(ptr));
272: }
274: PETSC_EXTERN void snessetfunction_(SNES *snes, Vec *r, void (*func)(SNES, Vec, Vec, void *, PetscErrorCode *), PetscCtx ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
275: {
276: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.function, (PetscFortranCallbackFn *)func, ctx);
277: if (*ierr) return;
278: #if PetscDefined(HAVE_F90_2PTR_ARG)
279: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.function_pgiptr, NULL, ptr);
280: if (*ierr) return;
281: #endif
282: *ierr = SNESSetFunction(*snes, *r, oursnesfunction, NULL);
283: }
285: PETSC_EXTERN void snessetfunctionnointerface_(SNES *snes, Vec *r, void (*func)(SNES, Vec, Vec, void *, PetscErrorCode *), PetscCtx ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
286: {
287: snessetfunction_(snes, r, func, ctx, ierr PETSC_F90_2PTR_PARAM(ptr));
288: }
290: PETSC_EXTERN void snessetobjective_(SNES *snes, SNESObjectiveFn func, PetscCtx ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
291: {
292: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.objective, (PetscFortranCallbackFn *)func, ctx);
293: if (*ierr) return;
294: #if PetscDefined(HAVE_F90_2PTR_ARG)
295: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.objective_pgiptr, NULL, ptr);
296: if (*ierr) return;
297: #endif
298: *ierr = SNESSetObjective(*snes, oursnesobjective, NULL);
299: }
301: PETSC_EXTERN void snessetobjectivenointerface_(SNES *snes, SNESObjectiveFn func, PetscCtx ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
302: {
303: snessetobjective_(snes, func, ctx, ierr PETSC_F90_2PTR_PARAM(ptr));
304: }
306: PETSC_EXTERN void snessetngs_(SNES *snes, void (*func)(SNES *, Vec *, Vec *, void *, PetscErrorCode *), PetscCtx ctx, PetscErrorCode *ierr)
307: {
308: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.ngs, (PetscFortranCallbackFn *)func, ctx);
309: if (*ierr) return;
310: *ierr = SNESSetNGS(*snes, oursnesngs, NULL);
311: }
312: PETSC_EXTERN void snessetupdate_(SNES *snes, void (*func)(SNES *, PetscInt *, PetscErrorCode *), PetscErrorCode *ierr)
313: {
314: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.update, (PetscFortranCallbackFn *)func, NULL);
315: if (*ierr) return;
316: *ierr = SNESSetUpdate(*snes, oursnesupdate);
317: }
319: /* the func argument is ignored */
320: PETSC_EXTERN void snesgetfunction_(SNES *snes, Vec *r, void (*func)(SNES, Vec, Vec, void *, PetscErrorCode *), void **ctx, PetscErrorCode *ierr)
321: {
322: CHKFORTRANNULLOBJECT(r);
323: *ierr = SNESGetFunction(*snes, r, NULL, NULL);
324: if (*ierr) return;
325: if ((PetscFortranCallbackFn *)func == (PetscFortranCallbackFn *)PETSC_NULL_FUNCTION_Fortran) return;
326: *ierr = PetscObjectGetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.function, NULL, ctx);
327: }
329: PETSC_EXTERN void snesgetngs_(SNES *snes, void *func, void **ctx, PetscErrorCode *ierr)
330: {
331: *ierr = PetscObjectGetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.ngs, NULL, ctx);
332: }
334: PETSC_EXTERN void snesconvergeddefault_(SNES *, PetscInt *, PetscReal *, PetscReal *, PetscReal *, SNESConvergedReason *, void *, PetscErrorCode *);
335: PETSC_EXTERN void snesconvergedskip_(SNES *, PetscInt *, PetscReal *, PetscReal *, PetscReal *, SNESConvergedReason *, void *, PetscErrorCode *);
337: PETSC_EXTERN void snessetconvergencetest_(SNES *snes, void (*func)(SNES *, PetscInt *, PetscReal *, PetscReal *, PetscReal *, SNESConvergedReason *, void *, PetscErrorCode *), void *cctx, PetscCtxDestroyFn *destroy, PetscErrorCode *ierr)
338: {
339: CHKFORTRANNULLFUNCTION(destroy);
341: if (func == snesconvergeddefault_) {
342: *ierr = SNESSetConvergenceTest(*snes, SNESConvergedDefault, NULL, NULL);
343: } else if (func == snesconvergedskip_) {
344: *ierr = SNESSetConvergenceTest(*snes, SNESConvergedSkip, NULL, NULL);
345: } else {
346: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.test, (PetscFortranCallbackFn *)func, cctx);
347: if (*ierr) return;
348: if (destroy) {
349: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.destroy, (PetscFortranCallbackFn *)destroy, cctx);
350: if (*ierr) return;
351: *ierr = SNESSetConvergenceTest(*snes, oursnestest, *snes, ourdestroy);
352: } else *ierr = SNESSetConvergenceTest(*snes, oursnestest, *snes, NULL);
353: }
354: }
356: PETSC_EXTERN void snesmonitordefault_(SNES *, PetscInt *, PetscReal *, PetscViewerAndFormat **, PetscErrorCode *);
358: PETSC_EXTERN void snesmonitorsolution_(SNES *snes, PetscInt *its, PetscReal *fgnorm, PetscViewerAndFormat **dummy, PetscErrorCode *ierr);
360: PETSC_EXTERN void snesmonitorsolutionupdate_(SNES *snes, PetscInt *its, PetscReal *fgnorm, PetscViewerAndFormat **dummy, PetscErrorCode *ierr);
362: PETSC_EXTERN void snesmonitorset_(SNES *snes, void (*func)(SNES *, PetscInt *, PetscReal *, void *, PetscErrorCode *), void *mctx, void (*mondestroy)(void *, PetscErrorCode *), PetscErrorCode *ierr)
363: {
364: CHKFORTRANNULLFUNCTION(mondestroy);
365: if ((PetscFortranCallbackFn *)func == (PetscFortranCallbackFn *)snesmonitordefault_) {
366: *ierr = SNESMonitorSet(*snes, (PetscErrorCode (*)(SNES, PetscInt, PetscReal, void *))SNESMonitorDefault, *(PetscViewerAndFormat **)mctx, (PetscCtxDestroyFn *)PetscViewerAndFormatDestroy);
367: } else if ((PetscFortranCallbackFn *)func == (PetscFortranCallbackFn *)snesmonitorsolution_) {
368: *ierr = SNESMonitorSet(*snes, (PetscErrorCode (*)(SNES, PetscInt, PetscReal, void *))SNESMonitorSolution, *(PetscViewerAndFormat **)mctx, (PetscCtxDestroyFn *)PetscViewerAndFormatDestroy);
369: } else if ((PetscFortranCallbackFn *)func == (PetscFortranCallbackFn *)snesmonitorsolutionupdate_) {
370: *ierr = SNESMonitorSet(*snes, (PetscErrorCode (*)(SNES, PetscInt, PetscReal, void *))SNESMonitorSolutionUpdate, *(PetscViewerAndFormat **)mctx, (PetscCtxDestroyFn *)PetscViewerAndFormatDestroy);
371: } else {
372: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.monitor, (PetscFortranCallbackFn *)func, mctx);
373: if (*ierr) return;
374: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.mondestroy, (PetscFortranCallbackFn *)mondestroy, mctx);
375: if (*ierr) return;
376: *ierr = SNESMonitorSet(*snes, oursnesmonitor, *snes, ourmondestroy);
377: }
378: }