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 snessetobjective_                SNESSETOBJECTIVE
 20:   #define snessetngs_                      SNESSETNGS
 21:   #define snessetupdate_                   SNESSETUPDATE
 22:   #define snesgetfunction_                 SNESGETFUNCTION
 23:   #define snesgetngs_                      SNESGETNGS
 24:   #define snessetconvergencetest_          SNESSETCONVERGENCETEST
 25:   #define snesconvergeddefault_            SNESCONVERGEDDEFAULT
 26:   #define snesconvergedskip_               SNESCONVERGEDSKIP
 27:   #define snesview_                        SNESVIEW
 28:   #define snesgetconvergencehistory_       SNESGETCONVERGENCEHISTORY
 29:   #define snesgetjacobian_                 SNESGETJACOBIAN
 30:   #define snessettype_                     SNESSETTYPE
 31:   #define snesappendoptionsprefix_         SNESAPPENDOPTIONSPREFIX
 32:   #define snessetoptionsprefix_            SNESSETOPTIONSPREFIX
 33:   #define snesmonitordefault_              SNESMONITORDEFAULT
 34:   #define snesmonitorsolution_             SNESMONITORSOLUTION
 35:   #define snesmonitorsolutionupdate_       SNESMONITORSOLUTIONUPDATE
 36:   #define snesmonitorset_                  SNESMONITORSET
 37:   #define snesnewtontrsetprecheck_         SNESNEWTONTRSETPRECHECK
 38:   #define snesnewtontrsetpostcheck_        SNESNEWTONTRSETPOSTCHECK
 39:   #define snesnewtontrdcsetprecheck_       SNESNEWTONTRDCSETPRECHECK
 40:   #define snesnewtontrdcsetpostcheck_      SNESNEWTONTRDCSETPOSTCHECK
 41:   #define snesviewfromoptions_             SNESVIEWFROMOPTIONS
 42:   #define snesgetconvergedreasonstring_    SNESGETCONVERGEDREASONSTRING
 43: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
 44:   #define snesconvergedreasonview_         snesconvergedreasonview
 45:   #define snessetpicard_                   snessetpicard
 46:   #define matmffdcomputejacobian_          matmffdcomputejacobian
 47:   #define snessolve_                       snessolve
 48:   #define snescomputejacobiandefault_      snescomputejacobiandefault
 49:   #define snescomputejacobiandefaultcolor_ snescomputejacobiandefaultcolor
 50:   #define snessetjacobian_                 snessetjacobian
 51:   #define snessetjacobian1_                snessetjacobian1
 52:   #define snessetjacobian2_                snessetjacobian2
 53:   #define snesgetoptionsprefix_            snesgetoptionsprefix
 54:   #define snesgettype_                     snesgettype
 55:   #define snessetfunction_                 snessetfunction
 56:   #define snessetobjective_                snessetobjective
 57:   #define snessetngs_                      snessetngs
 58:   #define snessetupdate_                   snessetupdate
 59:   #define snesgetfunction_                 snesgetfunction
 60:   #define snesgetngs_                      snesgetngs
 61:   #define snessetconvergencetest_          snessetconvergencetest
 62:   #define snesconvergeddefault_            snesconvergeddefault
 63:   #define snesconvergedskip_               snesconvergedskip
 64:   #define snesview_                        snesview
 65:   #define snesgetjacobian_                 snesgetjacobian
 66:   #define snesgetconvergencehistory_       snesgetconvergencehistory
 67:   #define snessettype_                     snessettype
 68:   #define snesappendoptionsprefix_         snesappendoptionsprefix
 69:   #define snessetoptionsprefix_            snessetoptionsprefix
 70:   #define snesmonitordefault_              snesmonitordefault
 71:   #define snesmonitorsolution_             snesmonitorsolution
 72:   #define snesmonitorsolutionupdate_       snesmonitorsolutionupdate
 73:   #define snesmonitorset_                  snesmonitorset
 74:   #define snesnewtontrsetprecheck_         snesnewtontrsetprecheck
 75:   #define snesnewtontrsetpostcheck_        snesnewtontrsetpostcheck
 76:   #define snesnewtontrdcsetprecheck_       snesnewtontrdcsetprecheck
 77:   #define snesnewtontrdcsetpostcheck_      snesnewtontrdcsetpostcheck
 78:   #define snesviewfromoptions_             snesviewfromoptions
 79:   #define snesgetconvergedreasonstring_    snesgetconvergedreasonstring
 80: #endif

 82: static struct {
 83:   PetscFortranCallbackId function;
 84:   PetscFortranCallbackId objective;
 85:   PetscFortranCallbackId test;
 86:   PetscFortranCallbackId destroy;
 87:   PetscFortranCallbackId jacobian;
 88:   PetscFortranCallbackId monitor;
 89:   PetscFortranCallbackId mondestroy;
 90:   PetscFortranCallbackId ngs;
 91:   PetscFortranCallbackId update;
 92:   PetscFortranCallbackId trprecheck;
 93:   PetscFortranCallbackId trpostcheck;
 94: #if defined(PETSC_HAVE_F90_2PTR_ARG)
 95:   PetscFortranCallbackId function_pgiptr;
 96:   PetscFortranCallbackId objective_pgiptr;
 97:   PetscFortranCallbackId trprecheck_pgiptr;
 98:   PetscFortranCallbackId trpostcheck_pgiptr;
 99: #endif
100: } _cb;

102: static PetscErrorCode ourtrprecheckfunction(SNES snes, Vec x, Vec y, PetscBool *changed_y, void *ctx)
103: {
104: #if defined(PETSC_HAVE_F90_2PTR_ARG)
105:   void *ptr;
106:   PetscCall(PetscObjectGetFortranCallback((PetscObject)snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.trprecheck_pgiptr, NULL, &ptr));
107: #endif
108:   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)));
109: }

111: PETSC_EXTERN void snesnewtontrsetprecheck_(SNES *snes, void (*func)(SNES, Vec, Vec, PetscBool *, void *), void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
112: {
113:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trprecheck, (PetscVoidFn *)func, ctx);
114:   if (*ierr) return;
115: #if defined(PETSC_HAVE_F90_2PTR_ARG)
116:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trprecheck_pgiptr, NULL, ptr);
117:   if (*ierr) return;
118: #endif
119:   *ierr = SNESNewtonTRSetPreCheck(*snes, ourtrprecheckfunction, NULL);
120: }

122: PETSC_EXTERN void snesnewtontrdcsetprecheck_(SNES *snes, void (*func)(SNES, Vec, Vec, PetscBool *, void *), void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
123: {
124:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trprecheck, (PetscVoidFn *)func, ctx);
125:   if (*ierr) return;
126: #if defined(PETSC_HAVE_F90_2PTR_ARG)
127:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trprecheck_pgiptr, NULL, ptr);
128:   if (*ierr) return;
129: #endif
130:   *ierr = SNESNewtonTRDCSetPreCheck(*snes, ourtrprecheckfunction, NULL);
131: }

133: static PetscErrorCode ourtrpostcheckfunction(SNES snes, Vec x, Vec y, Vec w, PetscBool *changed_y, PetscBool *changed_w, void *ctx)
134: {
135: #if defined(PETSC_HAVE_F90_2PTR_ARG)
136:   void *ptr;
137:   PetscCall(PetscObjectGetFortranCallback((PetscObject)snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.trpostcheck_pgiptr, NULL, &ptr));
138: #endif
139:   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)));
140: }

142: PETSC_EXTERN void snesnewtontrsetpostcheck_(SNES *snes, void (*func)(SNES, Vec, Vec, Vec, PetscBool *, PetscBool *, void *), void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
143: {
144:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trpostcheck, (PetscVoidFn *)func, ctx);
145:   if (*ierr) return;
146: #if defined(PETSC_HAVE_F90_2PTR_ARG)
147:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trpostcheck_pgiptr, NULL, ptr);
148:   if (*ierr) return;
149: #endif
150:   *ierr = SNESNewtonTRSetPostCheck(*snes, ourtrpostcheckfunction, NULL);
151: }

153: PETSC_EXTERN void snesnewtontrdcsetpostcheck_(SNES *snes, void (*func)(SNES, Vec, Vec, Vec, PetscBool *, PetscBool *, void *), void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
154: {
155:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trpostcheck, (PetscVoidFn *)func, ctx);
156:   if (*ierr) return;
157: #if defined(PETSC_HAVE_F90_2PTR_ARG)
158:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trpostcheck_pgiptr, NULL, ptr);
159:   if (*ierr) return;
160: #endif
161:   *ierr = SNESNewtonTRDCSetPostCheck(*snes, ourtrpostcheckfunction, NULL);
162: }

164: static PetscErrorCode oursnesfunction(SNES snes, Vec x, Vec f, void *ctx)
165: {
166: #if defined(PETSC_HAVE_F90_2PTR_ARG)
167:   void *ptr;
168:   PetscCall(PetscObjectGetFortranCallback((PetscObject)snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.function_pgiptr, NULL, &ptr));
169: #endif
170:   PetscObjectUseFortranCallback(snes, _cb.function, (SNES *, Vec *, Vec *, void *, PetscErrorCode *PETSC_F90_2PTR_PROTO_NOVAR), (&snes, &x, &f, _ctx, &ierr PETSC_F90_2PTR_PARAM(ptr)));
171: }

173: static PetscErrorCode oursnesobjective(SNES snes, Vec x, PetscReal *v, void *ctx)
174: {
175: #if defined(PETSC_HAVE_F90_2PTR_ARG)
176:   void *ptr;
177:   PetscCall(PetscObjectGetFortranCallback((PetscObject)snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.objective_pgiptr, NULL, &ptr));
178: #endif
179:   PetscObjectUseFortranCallback(snes, _cb.objective, (SNES *, Vec *, PetscReal *, void *, PetscErrorCode *PETSC_F90_2PTR_PROTO_NOVAR), (&snes, &x, v, _ctx, &ierr PETSC_F90_2PTR_PARAM(ptr)));
180: }

182: static PetscErrorCode oursnestest(SNES snes, PetscInt it, PetscReal a, PetscReal d, PetscReal c, SNESConvergedReason *reason, void *ctx)
183: {
184:   PetscObjectUseFortranCallback(snes, _cb.test, (SNES *, PetscInt *, PetscReal *, PetscReal *, PetscReal *, SNESConvergedReason *, void *, PetscErrorCode *), (&snes, &it, &a, &d, &c, reason, _ctx, &ierr));
185: }

187: static PetscErrorCode ourdestroy(void *ctx)
188: {
189:   PetscObjectUseFortranCallback(ctx, _cb.destroy, (void *, PetscErrorCode *), (_ctx, &ierr));
190: }

192: static PetscErrorCode oursnesjacobian(SNES snes, Vec x, Mat m, Mat p, void *ctx)
193: {
194:   PetscObjectUseFortranCallback(snes, _cb.jacobian, (SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&snes, &x, &m, &p, _ctx, &ierr));
195: }

197: static PetscErrorCode oursnesupdate(SNES snes, PetscInt i)
198: {
199:   PetscObjectUseFortranCallback(snes, _cb.update, (SNES *, PetscInt *, PetscErrorCode *), (&snes, &i, &ierr));
200: }
201: static PetscErrorCode oursnesngs(SNES snes, Vec x, Vec b, void *ctx)
202: {
203:   PetscObjectUseFortranCallback(snes, _cb.ngs, (SNES *, Vec *, Vec *, void *, PetscErrorCode *), (&snes, &x, &b, _ctx, &ierr));
204: }
205: static PetscErrorCode oursnesmonitor(SNES snes, PetscInt i, PetscReal d, void *ctx)
206: {
207:   PetscObjectUseFortranCallback(snes, _cb.monitor, (SNES *, PetscInt *, PetscReal *, void *, PetscErrorCode *), (&snes, &i, &d, _ctx, &ierr));
208: }
209: static PetscErrorCode ourmondestroy(void **ctx)
210: {
211:   SNES snes = (SNES)*ctx;
212:   PetscObjectUseFortranCallback(snes, _cb.mondestroy, (void *, PetscErrorCode *), (_ctx, &ierr));
213: }

215: /*
216:      snescomputejacobiandefault() and snescomputejacobiandefaultcolor()
217:   These can be used directly from Fortran but are mostly so that
218:   Fortran SNESSetJacobian() will properly handle the defaults being passed in.
219: */
220: PETSC_EXTERN void matmffdcomputejacobian_(SNES *snes, Vec *x, Mat *m, Mat *p, void *ctx, PetscErrorCode *ierr)
221: {
222:   *ierr = MatMFFDComputeJacobian(*snes, *x, *m, *p, ctx);
223: }
224: PETSC_EXTERN void snescomputejacobiandefault_(SNES *snes, Vec *x, Mat *m, Mat *p, void *ctx, PetscErrorCode *ierr)
225: {
226:   *ierr = SNESComputeJacobianDefault(*snes, *x, *m, *p, ctx);
227: }
228: PETSC_EXTERN void snescomputejacobiandefaultcolor_(SNES *snes, Vec *x, Mat *m, Mat *p, void *ctx, PetscErrorCode *ierr)
229: {
230:   *ierr = SNESComputeJacobianDefaultColor(*snes, *x, *m, *p, *(MatFDColoring *)ctx);
231: }

233: PETSC_EXTERN void snessetjacobian_(SNES *snes, Mat *A, Mat *B, void (*func)(SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
234: {
235:   CHKFORTRANNULLFUNCTION(func);
236:   if ((PetscVoidFn *)func == (PetscVoidFn *)snescomputejacobiandefault_) {
237:     *ierr = SNESSetJacobian(*snes, *A, *B, SNESComputeJacobianDefault, ctx);
238:   } else if ((PetscVoidFn *)func == (PetscVoidFn *)snescomputejacobiandefaultcolor_) {
239:     if (!ctx) {
240:       *ierr = PETSC_ERR_ARG_NULL;
241:       return;
242:     }
243:     *ierr = SNESSetJacobian(*snes, *A, *B, SNESComputeJacobianDefaultColor, *(MatFDColoring *)ctx);
244:   } else if ((PetscVoidFn *)func == (PetscVoidFn *)matmffdcomputejacobian_) {
245:     *ierr = SNESSetJacobian(*snes, *A, *B, MatMFFDComputeJacobian, ctx);
246:   } else {
247:     *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.jacobian, (PetscVoidFn *)func, ctx);
248:     if (!*ierr) *ierr = SNESSetJacobian(*snes, *A, *B, oursnesjacobian, NULL);
249:   }
250: }
251: PETSC_EXTERN void snessetjacobian1_(SNES *snes, Mat *A, Mat *B, void (*func)(SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
252: {
253:   snessetjacobian_(snes, A, B, func, ctx, ierr);
254: }
255: PETSC_EXTERN void snessetjacobian2_(SNES *snes, Mat *A, Mat *B, void (*func)(SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
256: {
257:   snessetjacobian_(snes, A, B, func, ctx, ierr);
258: }

260: static PetscErrorCode oursnespicardfunction(SNES snes, Vec x, Vec f, void *ctx)
261: {
262: #if defined(PETSC_HAVE_F90_2PTR_ARG)
263:   void *ptr;
264:   PetscCall(PetscObjectGetFortranCallback((PetscObject)snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.function_pgiptr, NULL, &ptr));
265: #endif
266:   PetscObjectUseFortranCallback(snes, _cb.function, (SNES *, Vec *, Vec *, void *, PetscErrorCode *PETSC_F90_2PTR_PROTO_NOVAR), (&snes, &x, &f, _ctx, &ierr PETSC_F90_2PTR_PARAM(ptr)));
267: }

269: static PetscErrorCode oursnespicardjacobian(SNES snes, Vec x, Mat m, Mat p, void *ctx)
270: {
271:   PetscObjectUseFortranCallback(snes, _cb.jacobian, (SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&snes, &x, &m, &p, _ctx, &ierr));
272: }

274: 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))
275: {
276:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.function, (PetscVoidFn *)func, ctx);
277: #if defined(PETSC_HAVE_F90_2PTR_ARG)
278:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.function_pgiptr, NULL, ptr);
279:   if (*ierr) return;
280: #endif
281:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.jacobian, (PetscVoidFn *)J, ctx);
282:   if (!*ierr) *ierr = SNESSetPicard(*snes, *r, oursnespicardfunction, *A, *B, oursnespicardjacobian, NULL);
283: }

285: PETSC_EXTERN void snesgetoptionsprefix_(SNES *snes, char *prefix, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
286: {
287:   const char *tname;

289:   *ierr = SNESGetOptionsPrefix(*snes, &tname);
290:   *ierr = PetscStrncpy(prefix, tname, len);
291:   if (*ierr) return;
292:   FIXRETURNCHAR(PETSC_TRUE, prefix, len);
293: }

295: PETSC_EXTERN void snesgettype_(SNES *snes, char *name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
296: {
297:   const char *tname;

299:   *ierr = SNESGetType(*snes, &tname);
300:   *ierr = PetscStrncpy(name, tname, len);
301:   if (*ierr) return;
302:   FIXRETURNCHAR(PETSC_TRUE, name, len);
303: }

305: /*
306:    These are not usually called from Fortran but allow Fortran users
307:    to transparently set these monitors from .F code
308: */

310: PETSC_EXTERN void snessetfunction_(SNES *snes, Vec *r, void (*func)(SNES *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
311: {
312:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.function, (PetscVoidFn *)func, ctx);
313:   if (*ierr) return;
314: #if defined(PETSC_HAVE_F90_2PTR_ARG)
315:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.function_pgiptr, NULL, ptr);
316:   if (*ierr) return;
317: #endif
318:   *ierr = SNESSetFunction(*snes, *r, oursnesfunction, NULL);
319: }

321: PETSC_EXTERN void snessetobjective_(SNES *snes, void (*func)(SNES *, Vec *, PetscReal *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
322: {
323:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.objective, (PetscVoidFn *)func, ctx);
324:   if (*ierr) return;
325: #if defined(PETSC_HAVE_F90_2PTR_ARG)
326:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.objective_pgiptr, NULL, ptr);
327:   if (*ierr) return;
328: #endif
329:   *ierr = SNESSetObjective(*snes, oursnesobjective, NULL);
330: }

332: PETSC_EXTERN void snessetngs_(SNES *snes, void (*func)(SNES *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
333: {
334:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.ngs, (PetscVoidFn *)func, ctx);
335:   if (*ierr) return;
336:   *ierr = SNESSetNGS(*snes, oursnesngs, NULL);
337: }
338: PETSC_EXTERN void snessetupdate_(SNES *snes, void (*func)(SNES *, PetscInt *, PetscErrorCode *), PetscErrorCode *ierr)
339: {
340:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.update, (PetscVoidFn *)func, NULL);
341:   if (*ierr) return;
342:   *ierr = SNESSetUpdate(*snes, oursnesupdate);
343: }

345: /* the func argument is ignored */
346: PETSC_EXTERN void snesgetfunction_(SNES *snes, Vec *r, void (*func)(SNES, Vec, Vec, void *), void **ctx, PetscErrorCode *ierr)
347: {
348:   CHKFORTRANNULLOBJECT(r);
349:   *ierr = SNESGetFunction(*snes, r, NULL, NULL);
350:   if (*ierr) return;
351:   if ((PetscVoidFn *)func == (PetscVoidFn *)PETSC_NULL_FUNCTION_Fortran) return;
352:   *ierr = PetscObjectGetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.function, NULL, ctx);
353: }

355: PETSC_EXTERN void snesgetngs_(SNES *snes, void *func, void **ctx, PetscErrorCode *ierr)
356: {
357:   *ierr = PetscObjectGetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.ngs, NULL, ctx);
358: }

360: PETSC_EXTERN void snesconvergeddefault_(SNES *snes, PetscInt *it, PetscReal *a, PetscReal *b, PetscReal *c, SNESConvergedReason *r, void *ct, PetscErrorCode *ierr)
361: {
362:   *ierr = SNESConvergedDefault(*snes, *it, *a, *b, *c, r, ct);
363: }

365: PETSC_EXTERN void snesconvergedskip_(SNES *snes, PetscInt *it, PetscReal *a, PetscReal *b, PetscReal *c, SNESConvergedReason *r, void *ct, PetscErrorCode *ierr)
366: {
367:   *ierr = SNESConvergedSkip(*snes, *it, *a, *b, *c, r, ct);
368: }

370: PETSC_EXTERN void snessetconvergencetest_(SNES *snes, void (*func)(SNES *, PetscInt *, PetscReal *, PetscReal *, PetscReal *, SNESConvergedReason *, void *, PetscErrorCode *), void *cctx, void (*destroy)(void *), PetscErrorCode *ierr)
371: {
372:   CHKFORTRANNULLFUNCTION(destroy);

374:   if ((PetscVoidFn *)func == (PetscVoidFn *)snesconvergeddefault_) {
375:     *ierr = SNESSetConvergenceTest(*snes, SNESConvergedDefault, NULL, NULL);
376:   } else if ((PetscVoidFn *)func == (PetscVoidFn *)snesconvergedskip_) {
377:     *ierr = SNESSetConvergenceTest(*snes, SNESConvergedSkip, NULL, NULL);
378:   } else {
379:     *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.test, (PetscVoidFn *)func, cctx);
380:     if (*ierr) return;
381:     *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.destroy, (PetscVoidFn *)destroy, cctx);
382:     if (*ierr) return;
383:     *ierr = SNESSetConvergenceTest(*snes, oursnestest, *snes, ourdestroy);
384:   }
385: }

387: PETSC_EXTERN void snesview_(SNES *snes, PetscViewer *viewer, PetscErrorCode *ierr)
388: {
389:   PetscViewer v;
390:   PetscPatchDefaultViewers_Fortran(viewer, v);
391:   *ierr = SNESView(*snes, v);
392: }

394: /*  func is currently ignored from Fortran */
395: PETSC_EXTERN void snesgetjacobian_(SNES *snes, Mat *A, Mat *B, int *func, void **ctx, PetscErrorCode *ierr)
396: {
397:   CHKFORTRANNULLINTEGER(ctx);
398:   CHKFORTRANNULLOBJECT(A);
399:   CHKFORTRANNULLOBJECT(B);
400:   *ierr = SNESGetJacobian(*snes, A, B, NULL, NULL);
401:   if (*ierr) return;
402:   *ierr = PetscObjectGetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.jacobian, NULL, ctx);
403: }

405: PETSC_EXTERN void snesgetconvergencehistory_(SNES *snes, PetscInt *na, PetscErrorCode *ierr)
406: {
407:   *ierr = SNESGetConvergenceHistory(*snes, NULL, NULL, na);
408: }

410: PETSC_EXTERN void snessettype_(SNES *snes, char *type, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
411: {
412:   char *t;

414:   FIXCHAR(type, len, t);
415:   *ierr = SNESSetType(*snes, t);
416:   if (*ierr) return;
417:   FREECHAR(type, t);
418: }

420: PETSC_EXTERN void snesappendoptionsprefix_(SNES *snes, char *prefix, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
421: {
422:   char *t;

424:   FIXCHAR(prefix, len, t);
425:   *ierr = SNESAppendOptionsPrefix(*snes, t);
426:   if (*ierr) return;
427:   FREECHAR(prefix, t);
428: }

430: PETSC_EXTERN void snessetoptionsprefix_(SNES *snes, char *prefix, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
431: {
432:   char *t;

434:   FIXCHAR(prefix, len, t);
435:   *ierr = SNESSetOptionsPrefix(*snes, t);
436:   if (*ierr) return;
437:   FREECHAR(prefix, t);
438: }

440: PETSC_EXTERN void snesmonitordefault_(SNES *snes, PetscInt *its, PetscReal *fgnorm, PetscViewerAndFormat **dummy, PetscErrorCode *ierr)
441: {
442:   *ierr = SNESMonitorDefault(*snes, *its, *fgnorm, *dummy);
443: }

445: PETSC_EXTERN void snesmonitorsolution_(SNES *snes, PetscInt *its, PetscReal *fgnorm, PetscViewerAndFormat **dummy, PetscErrorCode *ierr)
446: {
447:   *ierr = SNESMonitorSolution(*snes, *its, *fgnorm, *dummy);
448: }

450: PETSC_EXTERN void snesmonitorsolutionupdate_(SNES *snes, PetscInt *its, PetscReal *fgnorm, PetscViewerAndFormat **dummy, PetscErrorCode *ierr)
451: {
452:   *ierr = SNESMonitorSolutionUpdate(*snes, *its, *fgnorm, *dummy);
453: }

455: PETSC_EXTERN void snesmonitorset_(SNES *snes, void (*func)(SNES *, PetscInt *, PetscReal *, void *, PetscErrorCode *), void *mctx, void (*mondestroy)(void *, PetscErrorCode *), PetscErrorCode *ierr)
456: {
457:   CHKFORTRANNULLFUNCTION(mondestroy);
458:   if ((PetscVoidFn *)func == (PetscVoidFn *)snesmonitordefault_) {
459:     *ierr = SNESMonitorSet(*snes, (PetscErrorCode(*)(SNES, PetscInt, PetscReal, void *))SNESMonitorDefault, *(PetscViewerAndFormat **)mctx, (PetscErrorCode(*)(void **))PetscViewerAndFormatDestroy);
460:   } else if ((PetscVoidFn *)func == (PetscVoidFn *)snesmonitorsolution_) {
461:     *ierr = SNESMonitorSet(*snes, (PetscErrorCode(*)(SNES, PetscInt, PetscReal, void *))SNESMonitorSolution, *(PetscViewerAndFormat **)mctx, (PetscErrorCode(*)(void **))PetscViewerAndFormatDestroy);
462:   } else if ((PetscVoidFn *)func == (PetscVoidFn *)snesmonitorsolutionupdate_) {
463:     *ierr = SNESMonitorSet(*snes, (PetscErrorCode(*)(SNES, PetscInt, PetscReal, void *))SNESMonitorSolutionUpdate, *(PetscViewerAndFormat **)mctx, (PetscErrorCode(*)(void **))PetscViewerAndFormatDestroy);
464:   } else {
465:     *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.monitor, (PetscVoidFn *)func, mctx);
466:     if (*ierr) return;
467:     *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.mondestroy, (PetscVoidFn *)mondestroy, mctx);
468:     if (*ierr) return;
469:     *ierr = SNESMonitorSet(*snes, oursnesmonitor, *snes, ourmondestroy);
470:   }
471: }

473: PETSC_EXTERN void snesviewfromoptions_(SNES *ao, PetscObject obj, char *type, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
474: {
475:   char *t;

477:   FIXCHAR(type, len, t);
478:   CHKFORTRANNULLOBJECT(obj);
479:   *ierr = SNESViewFromOptions(*ao, obj, t);
480:   if (*ierr) return;
481:   FREECHAR(type, t);
482: }

484: PETSC_EXTERN void snesconvergedreasonview_(SNES *snes, PetscViewer *viewer, PetscErrorCode *ierr)
485: {
486:   PetscViewer v;
487:   PetscPatchDefaultViewers_Fortran(viewer, v);
488:   *ierr = SNESConvergedReasonView(*snes, v);
489: }

491: PETSC_EXTERN void snesgetconvergedreasonstring_(SNES *snes, char *strreason, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
492: {
493:   const char *tstrreason;
494:   *ierr = SNESGetConvergedReasonString(*snes, &tstrreason);
495:   *ierr = PetscStrncpy(strreason, tstrreason, len);
496:   if (*ierr) return;
497:   FIXRETURNCHAR(PETSC_TRUE, strreason, len);
498: }