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