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, PetscCtx 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 *), PetscCtx ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
     96: {
     97:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trprecheck, (PetscFortranCallbackFn *)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 *), PetscCtx ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
    107: {
    108:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trprecheck, (PetscFortranCallbackFn *)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, PetscCtx 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 *), PetscCtx ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
    127: {
    128:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trpostcheck, (PetscFortranCallbackFn *)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 *), PetscCtx ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
    138: {
    139:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trpostcheck, (PetscFortranCallbackFn *)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, PetscCtx 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, PetscCtx 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, PetscCtx 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(PetscCtxRt ctx)
    172: {
    173:   PetscObjectUseFortranCallback(ctx, _cb.destroy, (void *, PetscErrorCode *), (_ctx, &ierr));
    174: }

    176: static PetscErrorCode oursnesjacobian(SNES snes, Vec x, Mat m, Mat p, PetscCtx 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, PetscCtx 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, PetscCtx ctx)
    190: {
    191:   PetscObjectUseFortranCallback(snes, _cb.monitor, (SNES *, PetscInt *, PetscReal *, void *, PetscErrorCode *), (&snes, &i, &d, _ctx, &ierr));
    192: }
    193: static PetscErrorCode ourmondestroy(PetscCtxRt ctx)
    194: {
    195:   SNES snes = *(SNES *)ctx;
    196:   PetscObjectUseFortranCallback(snes, _cb.mondestroy, (void *, PetscErrorCode *), (_ctx, &ierr));
    197: }

    199: PETSC_EXTERN void snescomputejacobiandefault_(SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *);
    200: PETSC_EXTERN void snescomputejacobiandefaultcolor_(SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *);
    201: PETSC_EXTERN void matmffdcomputejacobian_(SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *);

    203: PETSC_EXTERN void snessetjacobian_(SNES *snes, Mat *A, Mat *B, void (*func)(SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), PetscCtx ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
    204: {
    205:   CHKFORTRANNULLFUNCTION(func);
    206:   if (func == snescomputejacobiandefault_) {
    207:     *ierr = SNESSetJacobian(*snes, *A, *B, SNESComputeJacobianDefault, ctx);
    208:   } else if (func == 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 (func == matmffdcomputejacobian_) {
    215:     *ierr = SNESSetJacobian(*snes, *A, *B, MatMFFDComputeJacobian, ctx);
    216:   } else {
    217:     *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.jacobian, (PetscFortranCallbackFn *)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, void (*func)(SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), PetscCtx ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
    223: {
    224:   snessetjacobian_(snes, A, B, func, 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, PetscCtx 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, PetscCtx 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, void (*func)(SNES, Vec, Vec, void *, PetscErrorCode *), Mat *A, Mat *B, void (*J)(SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), PetscCtx ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
    260: {
    261:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.function, (PetscFortranCallbackFn *)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, (PetscFortranCallbackFn *)J, ctx);
    267:   if (!*ierr) *ierr = SNESSetPicard(*snes, *r, oursnespicardfunction, *A, *B, oursnespicardjacobian, NULL);
    268: }

    270: PETSC_EXTERN void snessetpicardnointerface_(SNES *snes, Vec *r, void (*func)(SNES, Vec, Vec, void *, PetscErrorCode *), Mat *A, Mat *B, void (*J)(SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), PetscCtx 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: PETSC_EXTERN void snessetfunction_(SNES *snes, Vec *r, void (*func)(SNES, Vec, Vec, void *, PetscErrorCode *), PetscCtx ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
    276: {
    277:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.function, (PetscFortranCallbackFn *)func, ctx);
    278:   if (*ierr) return;
    279: #if defined(PETSC_HAVE_F90_2PTR_ARG)
    280:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.function_pgiptr, NULL, ptr);
    281:   if (*ierr) return;
    282: #endif
    283:   *ierr = SNESSetFunction(*snes, *r, oursnesfunction, NULL);
    284: }

    286: PETSC_EXTERN void snessetfunctionnointerface_(SNES *snes, Vec *r, void (*func)(SNES, Vec, Vec, void *, PetscErrorCode *), PetscCtx ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
    287: {
    288:   snessetfunction_(snes, r, func, ctx, ierr PETSC_F90_2PTR_PARAM(ptr));
    289: }

    291: PETSC_EXTERN void snessetobjective_(SNES *snes, SNESObjectiveFn func, PetscCtx ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
    292: {
    293:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.objective, (PetscFortranCallbackFn *)func, ctx);
    294:   if (*ierr) return;
    295: #if defined(PETSC_HAVE_F90_2PTR_ARG)
    296:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.objective_pgiptr, NULL, ptr);
    297:   if (*ierr) return;
    298: #endif
    299:   *ierr = SNESSetObjective(*snes, oursnesobjective, NULL);
    300: }

    302: PETSC_EXTERN void snessetobjectivenointerface_(SNES *snes, SNESObjectiveFn func, PetscCtx ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
    303: {
    304:   snessetobjective_(snes, func, ctx, ierr PETSC_F90_2PTR_PARAM(ptr));
    305: }

    307: PETSC_EXTERN void snessetngs_(SNES *snes, void (*func)(SNES *, Vec *, Vec *, void *, PetscErrorCode *), PetscCtx ctx, PetscErrorCode *ierr)
    308: {
    309:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.ngs, (PetscFortranCallbackFn *)func, ctx);
    310:   if (*ierr) return;
    311:   *ierr = SNESSetNGS(*snes, oursnesngs, NULL);
    312: }
    313: PETSC_EXTERN void snessetupdate_(SNES *snes, void (*func)(SNES *, PetscInt *, PetscErrorCode *), PetscErrorCode *ierr)
    314: {
    315:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.update, (PetscFortranCallbackFn *)func, NULL);
    316:   if (*ierr) return;
    317:   *ierr = SNESSetUpdate(*snes, oursnesupdate);
    318: }

    320: /* the func argument is ignored */
    321: PETSC_EXTERN void snesgetfunction_(SNES *snes, Vec *r, void (*func)(SNES, Vec, Vec, void *, PetscErrorCode *), void **ctx, PetscErrorCode *ierr)
    322: {
    323:   CHKFORTRANNULLOBJECT(r);
    324:   *ierr = SNESGetFunction(*snes, r, NULL, NULL);
    325:   if (*ierr) return;
    326:   if ((PetscFortranCallbackFn *)func == (PetscFortranCallbackFn *)PETSC_NULL_FUNCTION_Fortran) return;
    327:   *ierr = PetscObjectGetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.function, NULL, ctx);
    328: }

    330: PETSC_EXTERN void snesgetngs_(SNES *snes, void *func, void **ctx, PetscErrorCode *ierr)
    331: {
    332:   *ierr = PetscObjectGetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.ngs, NULL, ctx);
    333: }

    335: PETSC_EXTERN void snesconvergeddefault_(SNES *, PetscInt *, PetscReal *, PetscReal *, PetscReal *, SNESConvergedReason *, void *, PetscErrorCode *);
    336: PETSC_EXTERN void snesconvergedskip_(SNES *, PetscInt *, PetscReal *, PetscReal *, PetscReal *, SNESConvergedReason *, void *, PetscErrorCode *);

    338: PETSC_EXTERN void snessetconvergencetest_(SNES *snes, void (*func)(SNES *, PetscInt *, PetscReal *, PetscReal *, PetscReal *, SNESConvergedReason *, void *, PetscErrorCode *), void *cctx, PetscCtxDestroyFn *destroy, PetscErrorCode *ierr)
    339: {
    340:   CHKFORTRANNULLFUNCTION(destroy);

    342:   if (func == snesconvergeddefault_) {
    343:     *ierr = SNESSetConvergenceTest(*snes, SNESConvergedDefault, NULL, NULL);
    344:   } else if (func == snesconvergedskip_) {
    345:     *ierr = SNESSetConvergenceTest(*snes, SNESConvergedSkip, NULL, NULL);
    346:   } else {
    347:     *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.test, (PetscFortranCallbackFn *)func, cctx);
    348:     if (*ierr) return;
    349:     if (destroy) {
    350:       *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.destroy, (PetscFortranCallbackFn *)destroy, cctx);
    351:       if (*ierr) return;
    352:       *ierr = SNESSetConvergenceTest(*snes, oursnestest, *snes, ourdestroy);
    353:     } else *ierr = SNESSetConvergenceTest(*snes, oursnestest, *snes, NULL);
    354:   }
    355: }

    357: PETSC_EXTERN void snesmonitordefault_(SNES *, PetscInt *, PetscReal *, PetscViewerAndFormat **, PetscErrorCode *);

    359: PETSC_EXTERN void snesmonitorsolution_(SNES *snes, PetscInt *its, PetscReal *fgnorm, PetscViewerAndFormat **dummy, PetscErrorCode *ierr);

    361: PETSC_EXTERN void snesmonitorsolutionupdate_(SNES *snes, PetscInt *its, PetscReal *fgnorm, PetscViewerAndFormat **dummy, PetscErrorCode *ierr);

    363: PETSC_EXTERN void snesmonitorset_(SNES *snes, void (*func)(SNES *, PetscInt *, PetscReal *, void *, PetscErrorCode *), void *mctx, void (*mondestroy)(void *, PetscErrorCode *), PetscErrorCode *ierr)
    364: {
    365:   CHKFORTRANNULLFUNCTION(mondestroy);
    366:   if ((PetscFortranCallbackFn *)func == (PetscFortranCallbackFn *)snesmonitordefault_) {
    367:     *ierr = SNESMonitorSet(*snes, (PetscErrorCode (*)(SNES, PetscInt, PetscReal, void *))SNESMonitorDefault, *(PetscViewerAndFormat **)mctx, (PetscCtxDestroyFn *)PetscViewerAndFormatDestroy);
    368:   } else if ((PetscFortranCallbackFn *)func == (PetscFortranCallbackFn *)snesmonitorsolution_) {
    369:     *ierr = SNESMonitorSet(*snes, (PetscErrorCode (*)(SNES, PetscInt, PetscReal, void *))SNESMonitorSolution, *(PetscViewerAndFormat **)mctx, (PetscCtxDestroyFn *)PetscViewerAndFormatDestroy);
    370:   } else if ((PetscFortranCallbackFn *)func == (PetscFortranCallbackFn *)snesmonitorsolutionupdate_) {
    371:     *ierr = SNESMonitorSet(*snes, (PetscErrorCode (*)(SNES, PetscInt, PetscReal, void *))SNESMonitorSolutionUpdate, *(PetscViewerAndFormat **)mctx, (PetscCtxDestroyFn *)PetscViewerAndFormatDestroy);
    372:   } else {
    373:     *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.monitor, (PetscFortranCallbackFn *)func, mctx);
    374:     if (*ierr) return;
    375:     *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.mondestroy, (PetscFortranCallbackFn *)mondestroy, mctx);
    376:     if (*ierr) return;
    377:     *ierr = SNESMonitorSet(*snes, oursnesmonitor, *snes, ourmondestroy);
    378:   }
    379: }