Date: 2025-03-29T05:58:40+00:00

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