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