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: }