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 snesconvergedreasonview_ SNESCONVERGEDREASONVIEW
8: #define snessetpicard_ SNESSETPICARD
9: #define matmffdcomputejacobian_ MATMFFDCOMPUTEJACOBIAN
10: #define snessolve_ SNESSOLVE
11: #define snescomputejacobiandefault_ SNESCOMPUTEJACOBIANDEFAULT
12: #define snescomputejacobiandefaultcolor_ SNESCOMPUTEJACOBIANDEFAULTCOLOR
13: #define snessetjacobian_ SNESSETJACOBIAN
14: #define snessetjacobian1_ SNESSETJACOBIAN1
15: #define snessetjacobian2_ SNESSETJACOBIAN2
16: #define snesgetoptionsprefix_ SNESGETOPTIONSPREFIX
17: #define snesgettype_ SNESGETTYPE
18: #define snessetfunction_ SNESSETFUNCTION
19: #define snessetngs_ SNESSETNGS
20: #define snessetupdate_ SNESSETUPDATE
21: #define snesgetfunction_ SNESGETFUNCTION
22: #define snesgetngs_ SNESGETNGS
23: #define snessetconvergencetest_ SNESSETCONVERGENCETEST
24: #define snesconvergeddefault_ SNESCONVERGEDDEFAULT
25: #define snesconvergedskip_ SNESCONVERGEDSKIP
26: #define snesview_ SNESVIEW
27: #define snesgetconvergencehistory_ SNESGETCONVERGENCEHISTORY
28: #define snesgetjacobian_ SNESGETJACOBIAN
29: #define snessettype_ SNESSETTYPE
30: #define snesappendoptionsprefix_ SNESAPPENDOPTIONSPREFIX
31: #define snessetoptionsprefix_ SNESSETOPTIONSPREFIX
32: #define snesmonitordefault_ SNESMONITORDEFAULT
33: #define snesmonitorsolution_ SNESMONITORSOLUTION
34: #define snesmonitorsolutionupdate_ SNESMONITORSOLUTIONUPDATE
35: #define snesmonitorset_ SNESMONITORSET
36: #define snesnewtontrsetprecheck_ SNESNEWTONTRSETPRECHECK
37: #define snesnewtontrsetpostcheck_ SNESNEWTONTRSETPOSTCHECK
38: #define snesnewtontrdcsetprecheck_ SNESNEWTONTRDCSETPRECHECK
39: #define snesnewtontrdcsetpostcheck_ SNESNEWTONTRDCSETPOSTCHECK
40: #define snesviewfromoptions_ SNESVIEWFROMOPTIONS
41: #define snesgetconvergedreasonstring_ SNESGETCONVERGEDREASONSTRING
42: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
43: #define snesconvergedreasonview_ snesconvergedreasonview
44: #define snessetpicard_ snessetpicard
45: #define matmffdcomputejacobian_ matmffdcomputejacobian
46: #define snessolve_ snessolve
47: #define snescomputejacobiandefault_ snescomputejacobiandefault
48: #define snescomputejacobiandefaultcolor_ snescomputejacobiandefaultcolor
49: #define snessetjacobian_ snessetjacobian
50: #define snessetjacobian1_ snessetjacobian1
51: #define snessetjacobian2_ snessetjacobian2
52: #define snesgetoptionsprefix_ snesgetoptionsprefix
53: #define snesgettype_ snesgettype
54: #define snessetfunction_ snessetfunction
55: #define snessetngs_ snessetngs
56: #define snessetupdate_ snessetupdate
57: #define snesgetfunction_ snesgetfunction
58: #define snesgetngs_ snesgetngs
59: #define snessetconvergencetest_ snessetconvergencetest
60: #define snesconvergeddefault_ snesconvergeddefault
61: #define snesconvergedskip_ snesconvergedskip
62: #define snesview_ snesview
63: #define snesgetjacobian_ snesgetjacobian
64: #define snesgetconvergencehistory_ snesgetconvergencehistory
65: #define snessettype_ snessettype
66: #define snesappendoptionsprefix_ snesappendoptionsprefix
67: #define snessetoptionsprefix_ snessetoptionsprefix
68: #define snesmonitordefault_ snesmonitordefault
69: #define snesmonitorsolution_ snesmonitorsolution
70: #define snesmonitorsolutionupdate_ snesmonitorsolutionupdate
71: #define snesmonitorset_ snesmonitorset
72: #define snesnewtontrsetprecheck_ snesnewtontrsetprecheck
73: #define snesnewtontrsetpostcheck_ snesnewtontrsetpostcheck
74: #define snesnewtontrdcsetprecheck_ snesnewtontrdcsetprecheck
75: #define snesnewtontrdcsetpostcheck_ snesnewtontrdcsetpostcheck
76: #define snesviewfromoptions_ snesviewfromoptions
77: #define snesgetconvergedreasonstring_ snesgetconvergedreasonstring
78: #endif
80: static struct {
81: PetscFortranCallbackId function;
82: PetscFortranCallbackId test;
83: PetscFortranCallbackId destroy;
84: PetscFortranCallbackId jacobian;
85: PetscFortranCallbackId monitor;
86: PetscFortranCallbackId mondestroy;
87: PetscFortranCallbackId ngs;
88: PetscFortranCallbackId update;
89: PetscFortranCallbackId trprecheck;
90: PetscFortranCallbackId trpostcheck;
91: #if defined(PETSC_HAVE_F90_2PTR_ARG)
92: PetscFortranCallbackId function_pgiptr;
93: PetscFortranCallbackId trprecheck_pgiptr;
94: PetscFortranCallbackId trpostcheck_pgiptr;
95: #endif
96: } _cb;
98: static PetscErrorCode ourtrprecheckfunction(SNES snes, Vec x, Vec y, PetscBool *changed_y, void *ctx)
99: {
100: #if defined(PETSC_HAVE_F90_2PTR_ARG)
101: void *ptr;
102: PetscCall(PetscObjectGetFortranCallback((PetscObject)snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.trprecheck_pgiptr, NULL, &ptr));
103: #endif
104: 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)));
105: }
107: PETSC_EXTERN void snesnewtontrsetprecheck_(SNES *snes, void (*func)(SNES, Vec, Vec, PetscBool *, void *), void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
108: {
109: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trprecheck, (PetscVoidFn *)func, ctx);
110: if (*ierr) return;
111: #if defined(PETSC_HAVE_F90_2PTR_ARG)
112: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trprecheck_pgiptr, NULL, ptr);
113: if (*ierr) return;
114: #endif
115: *ierr = SNESNewtonTRSetPreCheck(*snes, ourtrprecheckfunction, NULL);
116: }
118: PETSC_EXTERN void snesnewtontrdcsetprecheck_(SNES *snes, void (*func)(SNES, Vec, Vec, PetscBool *, void *), void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
119: {
120: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trprecheck, (PetscVoidFn *)func, ctx);
121: if (*ierr) return;
122: #if defined(PETSC_HAVE_F90_2PTR_ARG)
123: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trprecheck_pgiptr, NULL, ptr);
124: if (*ierr) return;
125: #endif
126: *ierr = SNESNewtonTRDCSetPreCheck(*snes, ourtrprecheckfunction, NULL);
127: }
129: static PetscErrorCode ourtrpostcheckfunction(SNES snes, Vec x, Vec y, Vec w, PetscBool *changed_y, PetscBool *changed_w, void *ctx)
130: {
131: #if defined(PETSC_HAVE_F90_2PTR_ARG)
132: void *ptr;
133: PetscCall(PetscObjectGetFortranCallback((PetscObject)snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.trpostcheck_pgiptr, NULL, &ptr));
134: #endif
135: 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)));
136: }
138: PETSC_EXTERN void snesnewtontrsetpostcheck_(SNES *snes, void (*func)(SNES, Vec, Vec, Vec, PetscBool *, PetscBool *, void *), void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
139: {
140: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trpostcheck, (PetscVoidFn *)func, ctx);
141: if (*ierr) return;
142: #if defined(PETSC_HAVE_F90_2PTR_ARG)
143: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trpostcheck_pgiptr, NULL, ptr);
144: if (*ierr) return;
145: #endif
146: *ierr = SNESNewtonTRSetPostCheck(*snes, ourtrpostcheckfunction, NULL);
147: }
149: PETSC_EXTERN void snesnewtontrdcsetpostcheck_(SNES *snes, void (*func)(SNES, Vec, Vec, Vec, PetscBool *, PetscBool *, void *), void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
150: {
151: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trpostcheck, (PetscVoidFn *)func, ctx);
152: if (*ierr) return;
153: #if defined(PETSC_HAVE_F90_2PTR_ARG)
154: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trpostcheck_pgiptr, NULL, ptr);
155: if (*ierr) return;
156: #endif
157: *ierr = SNESNewtonTRDCSetPostCheck(*snes, ourtrpostcheckfunction, NULL);
158: }
160: static PetscErrorCode oursnesfunction(SNES snes, Vec x, Vec f, void *ctx)
161: {
162: #if defined(PETSC_HAVE_F90_2PTR_ARG)
163: void *ptr;
164: PetscCall(PetscObjectGetFortranCallback((PetscObject)snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.function_pgiptr, NULL, &ptr));
165: #endif
166: PetscObjectUseFortranCallback(snes, _cb.function, (SNES *, Vec *, Vec *, void *, PetscErrorCode *PETSC_F90_2PTR_PROTO_NOVAR), (&snes, &x, &f, _ctx, &ierr PETSC_F90_2PTR_PARAM(ptr)));
167: }
169: static PetscErrorCode oursnestest(SNES snes, PetscInt it, PetscReal a, PetscReal d, PetscReal c, SNESConvergedReason *reason, void *ctx)
170: {
171: PetscObjectUseFortranCallback(snes, _cb.test, (SNES *, PetscInt *, PetscReal *, PetscReal *, PetscReal *, SNESConvergedReason *, void *, PetscErrorCode *), (&snes, &it, &a, &d, &c, reason, _ctx, &ierr));
172: }
174: static PetscErrorCode ourdestroy(void *ctx)
175: {
176: PetscObjectUseFortranCallback(ctx, _cb.destroy, (void *, PetscErrorCode *), (_ctx, &ierr));
177: }
179: static PetscErrorCode oursnesjacobian(SNES snes, Vec x, Mat m, Mat p, void *ctx)
180: {
181: PetscObjectUseFortranCallback(snes, _cb.jacobian, (SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&snes, &x, &m, &p, _ctx, &ierr));
182: }
184: static PetscErrorCode oursnesupdate(SNES snes, PetscInt i)
185: {
186: PetscObjectUseFortranCallback(snes, _cb.update, (SNES *, PetscInt *, PetscErrorCode *), (&snes, &i, &ierr));
187: }
188: static PetscErrorCode oursnesngs(SNES snes, Vec x, Vec b, void *ctx)
189: {
190: PetscObjectUseFortranCallback(snes, _cb.ngs, (SNES *, Vec *, Vec *, void *, PetscErrorCode *), (&snes, &x, &b, _ctx, &ierr));
191: }
192: static PetscErrorCode oursnesmonitor(SNES snes, PetscInt i, PetscReal d, void *ctx)
193: {
194: PetscObjectUseFortranCallback(snes, _cb.monitor, (SNES *, PetscInt *, PetscReal *, void *, PetscErrorCode *), (&snes, &i, &d, _ctx, &ierr));
195: }
196: static PetscErrorCode ourmondestroy(void **ctx)
197: {
198: SNES snes = (SNES)*ctx;
199: PetscObjectUseFortranCallback(snes, _cb.mondestroy, (void *, PetscErrorCode *), (_ctx, &ierr));
200: }
202: /*
203: snescomputejacobiandefault() and snescomputejacobiandefaultcolor()
204: These can be used directly from Fortran but are mostly so that
205: Fortran SNESSetJacobian() will properly handle the defaults being passed in.
206: */
207: PETSC_EXTERN void matmffdcomputejacobian_(SNES *snes, Vec *x, Mat *m, Mat *p, void *ctx, PetscErrorCode *ierr)
208: {
209: *ierr = MatMFFDComputeJacobian(*snes, *x, *m, *p, ctx);
210: }
211: PETSC_EXTERN void snescomputejacobiandefault_(SNES *snes, Vec *x, Mat *m, Mat *p, void *ctx, PetscErrorCode *ierr)
212: {
213: *ierr = SNESComputeJacobianDefault(*snes, *x, *m, *p, ctx);
214: }
215: PETSC_EXTERN void snescomputejacobiandefaultcolor_(SNES *snes, Vec *x, Mat *m, Mat *p, void *ctx, PetscErrorCode *ierr)
216: {
217: *ierr = SNESComputeJacobianDefaultColor(*snes, *x, *m, *p, *(MatFDColoring *)ctx);
218: }
220: PETSC_EXTERN void snessetjacobian_(SNES *snes, Mat *A, Mat *B, void (*func)(SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
221: {
222: CHKFORTRANNULLFUNCTION(func);
223: if ((PetscVoidFn *)func == (PetscVoidFn *)snescomputejacobiandefault_) {
224: *ierr = SNESSetJacobian(*snes, *A, *B, SNESComputeJacobianDefault, ctx);
225: } else if ((PetscVoidFn *)func == (PetscVoidFn *)snescomputejacobiandefaultcolor_) {
226: if (!ctx) {
227: *ierr = PETSC_ERR_ARG_NULL;
228: return;
229: }
230: *ierr = SNESSetJacobian(*snes, *A, *B, SNESComputeJacobianDefaultColor, *(MatFDColoring *)ctx);
231: } else if ((PetscVoidFn *)func == (PetscVoidFn *)matmffdcomputejacobian_) {
232: *ierr = SNESSetJacobian(*snes, *A, *B, MatMFFDComputeJacobian, ctx);
233: } else {
234: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.jacobian, (PetscVoidFn *)func, ctx);
235: if (!*ierr) *ierr = SNESSetJacobian(*snes, *A, *B, oursnesjacobian, NULL);
236: }
237: }
238: PETSC_EXTERN void snessetjacobian1_(SNES *snes, Mat *A, Mat *B, void (*func)(SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
239: {
240: snessetjacobian_(snes, A, B, func, ctx, ierr);
241: }
242: PETSC_EXTERN void snessetjacobian2_(SNES *snes, Mat *A, Mat *B, void (*func)(SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
243: {
244: snessetjacobian_(snes, A, B, func, ctx, ierr);
245: }
247: static PetscErrorCode oursnespicardfunction(SNES snes, Vec x, Vec f, void *ctx)
248: {
249: #if defined(PETSC_HAVE_F90_2PTR_ARG)
250: void *ptr;
251: PetscCall(PetscObjectGetFortranCallback((PetscObject)snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.function_pgiptr, NULL, &ptr));
252: #endif
253: PetscObjectUseFortranCallback(snes, _cb.function, (SNES *, Vec *, Vec *, void *, PetscErrorCode *PETSC_F90_2PTR_PROTO_NOVAR), (&snes, &x, &f, _ctx, &ierr PETSC_F90_2PTR_PARAM(ptr)));
254: }
256: static PetscErrorCode oursnespicardjacobian(SNES snes, Vec x, Mat m, Mat p, void *ctx)
257: {
258: PetscObjectUseFortranCallback(snes, _cb.jacobian, (SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&snes, &x, &m, &p, _ctx, &ierr));
259: }
261: PETSC_EXTERN void snessetpicard_(SNES *snes, Vec *r, void (*func)(SNES *, Vec *, Vec *, void *, PetscErrorCode *), Mat *A, Mat *B, PetscErrorCode (*J)(SNES, Vec, Mat, Mat, void *), void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
262: {
263: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.function, (PetscVoidFn *)func, ctx);
264: #if defined(PETSC_HAVE_F90_2PTR_ARG)
265: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.function_pgiptr, NULL, ptr);
266: if (*ierr) return;
267: #endif
268: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.jacobian, (PetscVoidFn *)J, ctx);
269: if (!*ierr) *ierr = SNESSetPicard(*snes, *r, oursnespicardfunction, *A, *B, oursnespicardjacobian, NULL);
270: }
272: PETSC_EXTERN void snesgetoptionsprefix_(SNES *snes, char *prefix, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
273: {
274: const char *tname;
276: *ierr = SNESGetOptionsPrefix(*snes, &tname);
277: *ierr = PetscStrncpy(prefix, tname, len);
278: if (*ierr) return;
279: FIXRETURNCHAR(PETSC_TRUE, prefix, len);
280: }
282: PETSC_EXTERN void snesgettype_(SNES *snes, char *name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
283: {
284: const char *tname;
286: *ierr = SNESGetType(*snes, &tname);
287: *ierr = PetscStrncpy(name, tname, len);
288: if (*ierr) return;
289: FIXRETURNCHAR(PETSC_TRUE, name, len);
290: }
292: /*
293: These are not usually called from Fortran but allow Fortran users
294: to transparently set these monitors from .F code
295: */
297: PETSC_EXTERN void snessetfunction_(SNES *snes, Vec *r, void (*func)(SNES *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
298: {
299: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.function, (PetscVoidFn *)func, ctx);
300: if (*ierr) return;
301: #if defined(PETSC_HAVE_F90_2PTR_ARG)
302: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.function_pgiptr, NULL, ptr);
303: if (*ierr) return;
304: #endif
305: *ierr = SNESSetFunction(*snes, *r, oursnesfunction, NULL);
306: }
308: PETSC_EXTERN void snessetngs_(SNES *snes, void (*func)(SNES *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
309: {
310: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.ngs, (PetscVoidFn *)func, ctx);
311: if (*ierr) return;
312: *ierr = SNESSetNGS(*snes, oursnesngs, NULL);
313: }
314: PETSC_EXTERN void snessetupdate_(SNES *snes, void (*func)(SNES *, PetscInt *, PetscErrorCode *), PetscErrorCode *ierr)
315: {
316: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.update, (PetscVoidFn *)func, NULL);
317: if (*ierr) return;
318: *ierr = SNESSetUpdate(*snes, oursnesupdate);
319: }
321: /* the func argument is ignored */
322: PETSC_EXTERN void snesgetfunction_(SNES *snes, Vec *r, void (*func)(SNES, Vec, Vec, void *), void **ctx, PetscErrorCode *ierr)
323: {
324: CHKFORTRANNULLOBJECT(r);
325: *ierr = SNESGetFunction(*snes, r, NULL, NULL);
326: if (*ierr) return;
327: if ((PetscVoidFn *)func == (PetscVoidFn *)PETSC_NULL_FUNCTION_Fortran) return;
328: *ierr = PetscObjectGetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.function, NULL, ctx);
329: }
331: PETSC_EXTERN void snesgetngs_(SNES *snes, void *func, void **ctx, PetscErrorCode *ierr)
332: {
333: *ierr = PetscObjectGetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.ngs, NULL, ctx);
334: }
336: PETSC_EXTERN void snesconvergeddefault_(SNES *snes, PetscInt *it, PetscReal *a, PetscReal *b, PetscReal *c, SNESConvergedReason *r, void *ct, PetscErrorCode *ierr)
337: {
338: *ierr = SNESConvergedDefault(*snes, *it, *a, *b, *c, r, ct);
339: }
341: PETSC_EXTERN void snesconvergedskip_(SNES *snes, PetscInt *it, PetscReal *a, PetscReal *b, PetscReal *c, SNESConvergedReason *r, void *ct, PetscErrorCode *ierr)
342: {
343: *ierr = SNESConvergedSkip(*snes, *it, *a, *b, *c, r, ct);
344: }
346: PETSC_EXTERN void snessetconvergencetest_(SNES *snes, void (*func)(SNES *, PetscInt *, PetscReal *, PetscReal *, PetscReal *, SNESConvergedReason *, void *, PetscErrorCode *), void *cctx, void (*destroy)(void *), PetscErrorCode *ierr)
347: {
348: CHKFORTRANNULLFUNCTION(destroy);
350: if ((PetscVoidFn *)func == (PetscVoidFn *)snesconvergeddefault_) {
351: *ierr = SNESSetConvergenceTest(*snes, SNESConvergedDefault, NULL, NULL);
352: } else if ((PetscVoidFn *)func == (PetscVoidFn *)snesconvergedskip_) {
353: *ierr = SNESSetConvergenceTest(*snes, SNESConvergedSkip, NULL, NULL);
354: } else {
355: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.test, (PetscVoidFn *)func, cctx);
356: if (*ierr) return;
357: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.destroy, (PetscVoidFn *)destroy, cctx);
358: if (*ierr) return;
359: *ierr = SNESSetConvergenceTest(*snes, oursnestest, *snes, ourdestroy);
360: }
361: }
363: PETSC_EXTERN void snesview_(SNES *snes, PetscViewer *viewer, PetscErrorCode *ierr)
364: {
365: PetscViewer v;
366: PetscPatchDefaultViewers_Fortran(viewer, v);
367: *ierr = SNESView(*snes, v);
368: }
370: /* func is currently ignored from Fortran */
371: PETSC_EXTERN void snesgetjacobian_(SNES *snes, Mat *A, Mat *B, int *func, void **ctx, PetscErrorCode *ierr)
372: {
373: CHKFORTRANNULLINTEGER(ctx);
374: CHKFORTRANNULLOBJECT(A);
375: CHKFORTRANNULLOBJECT(B);
376: *ierr = SNESGetJacobian(*snes, A, B, NULL, NULL);
377: if (*ierr) return;
378: *ierr = PetscObjectGetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.jacobian, NULL, ctx);
379: }
381: PETSC_EXTERN void snesgetconvergencehistory_(SNES *snes, PetscInt *na, PetscErrorCode *ierr)
382: {
383: *ierr = SNESGetConvergenceHistory(*snes, NULL, NULL, na);
384: }
386: PETSC_EXTERN void snessettype_(SNES *snes, char *type, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
387: {
388: char *t;
390: FIXCHAR(type, len, t);
391: *ierr = SNESSetType(*snes, t);
392: if (*ierr) return;
393: FREECHAR(type, t);
394: }
396: PETSC_EXTERN void snesappendoptionsprefix_(SNES *snes, char *prefix, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
397: {
398: char *t;
400: FIXCHAR(prefix, len, t);
401: *ierr = SNESAppendOptionsPrefix(*snes, t);
402: if (*ierr) return;
403: FREECHAR(prefix, t);
404: }
406: PETSC_EXTERN void snessetoptionsprefix_(SNES *snes, char *prefix, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
407: {
408: char *t;
410: FIXCHAR(prefix, len, t);
411: *ierr = SNESSetOptionsPrefix(*snes, t);
412: if (*ierr) return;
413: FREECHAR(prefix, t);
414: }
416: PETSC_EXTERN void snesmonitordefault_(SNES *snes, PetscInt *its, PetscReal *fgnorm, PetscViewerAndFormat **dummy, PetscErrorCode *ierr)
417: {
418: *ierr = SNESMonitorDefault(*snes, *its, *fgnorm, *dummy);
419: }
421: PETSC_EXTERN void snesmonitorsolution_(SNES *snes, PetscInt *its, PetscReal *fgnorm, PetscViewerAndFormat **dummy, PetscErrorCode *ierr)
422: {
423: *ierr = SNESMonitorSolution(*snes, *its, *fgnorm, *dummy);
424: }
426: PETSC_EXTERN void snesmonitorsolutionupdate_(SNES *snes, PetscInt *its, PetscReal *fgnorm, PetscViewerAndFormat **dummy, PetscErrorCode *ierr)
427: {
428: *ierr = SNESMonitorSolutionUpdate(*snes, *its, *fgnorm, *dummy);
429: }
431: PETSC_EXTERN void snesmonitorset_(SNES *snes, void (*func)(SNES *, PetscInt *, PetscReal *, void *, PetscErrorCode *), void *mctx, void (*mondestroy)(void *, PetscErrorCode *), PetscErrorCode *ierr)
432: {
433: CHKFORTRANNULLFUNCTION(mondestroy);
434: if ((PetscVoidFn *)func == (PetscVoidFn *)snesmonitordefault_) {
435: *ierr = SNESMonitorSet(*snes, (PetscErrorCode(*)(SNES, PetscInt, PetscReal, void *))SNESMonitorDefault, *(PetscViewerAndFormat **)mctx, (PetscErrorCode(*)(void **))PetscViewerAndFormatDestroy);
436: } else if ((PetscVoidFn *)func == (PetscVoidFn *)snesmonitorsolution_) {
437: *ierr = SNESMonitorSet(*snes, (PetscErrorCode(*)(SNES, PetscInt, PetscReal, void *))SNESMonitorSolution, *(PetscViewerAndFormat **)mctx, (PetscErrorCode(*)(void **))PetscViewerAndFormatDestroy);
438: } else if ((PetscVoidFn *)func == (PetscVoidFn *)snesmonitorsolutionupdate_) {
439: *ierr = SNESMonitorSet(*snes, (PetscErrorCode(*)(SNES, PetscInt, PetscReal, void *))SNESMonitorSolutionUpdate, *(PetscViewerAndFormat **)mctx, (PetscErrorCode(*)(void **))PetscViewerAndFormatDestroy);
440: } else {
441: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.monitor, (PetscVoidFn *)func, mctx);
442: if (*ierr) return;
443: *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.mondestroy, (PetscVoidFn *)mondestroy, mctx);
444: if (*ierr) return;
445: *ierr = SNESMonitorSet(*snes, oursnesmonitor, *snes, ourmondestroy);
446: }
447: }
449: PETSC_EXTERN void snesviewfromoptions_(SNES *ao, PetscObject obj, char *type, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
450: {
451: char *t;
453: FIXCHAR(type, len, t);
454: CHKFORTRANNULLOBJECT(obj);
455: *ierr = SNESViewFromOptions(*ao, obj, t);
456: if (*ierr) return;
457: FREECHAR(type, t);
458: }
460: PETSC_EXTERN void snesconvergedreasonview_(SNES *snes, PetscViewer *viewer, PetscErrorCode *ierr)
461: {
462: PetscViewer v;
463: PetscPatchDefaultViewers_Fortran(viewer, v);
464: *ierr = SNESConvergedReasonView(*snes, v);
465: }
467: PETSC_EXTERN void snesgetconvergedreasonstring_(SNES *snes, char *strreason, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
468: {
469: const char *tstrreason;
470: *ierr = SNESGetConvergedReasonString(*snes, &tstrreason);
471: *ierr = PetscStrncpy(strreason, tstrreason, len);
472: if (*ierr) return;
473: FIXRETURNCHAR(PETSC_TRUE, strreason, len);
474: }