Actual source code: zsnesf.c

      1: #include <petsc/private/fortranimpl.h>
      2: #include <petscsnes.h>
      3: #include <petscviewer.h>
      4: #include <petsc/private/f90impl.h>

      6: #if defined(PETSC_HAVE_FORTRAN_CAPS)
      7:   #define snessetpicard_                   SNESSETPICARD
      8:   #define snessetpicardnointerface_        SNESSETPICARDNOINTERFACE
      9:   #define snessolve_                       SNESSOLVE
     10:   #define snescomputejacobiandefault_      SNESCOMPUTEJACOBIANDEFAULT
     11:   #define snescomputejacobiandefaultcolor_ SNESCOMPUTEJACOBIANDEFAULTCOLOR
     12:   #define snessetjacobian_                 SNESSETJACOBIAN
     13:   #define snessetjacobiannointerface_      SNESSETJACOBIANNOINTERFACE
     14:   #define snessetfunction_                 SNESSETFUNCTION
     15:   #define snessetfunctionnointerface_      SNESSETFUNCTIONNOINTERFACE
     16:   #define snessetobjective_                SNESSETOBJECTIVE
     17:   #define snessetobjectivenointerface_     SNESSETOBJECTIVENOINTERFACE
     18:   #define snessetngs_                      SNESSETNGS
     19:   #define snessetupdate_                   SNESSETUPDATE
     20:   #define snesgetfunction_                 SNESGETFUNCTION
     21:   #define snesgetngs_                      SNESGETNGS
     22:   #define snessetconvergencetest_          SNESSETCONVERGENCETEST
     23:   #define snesconvergeddefault_            SNESCONVERGEDDEFAULT
     24:   #define snesconvergedskip_               SNESCONVERGEDSKIP
     25:   #define snesgetconvergencehistory_       SNESGETCONVERGENCEHISTORY
     26:   #define snesgetjacobian_                 SNESGETJACOBIAN
     27:   #define snesmonitordefault_              SNESMONITORDEFAULT
     28:   #define snesmonitorsolution_             SNESMONITORSOLUTION
     29:   #define snesmonitorsolutionupdate_       SNESMONITORSOLUTIONUPDATE
     30:   #define snesmonitorset_                  SNESMONITORSET
     31:   #define snesnewtontrsetprecheck_         SNESNEWTONTRSETPRECHECK
     32:   #define snesnewtontrsetpostcheck_        SNESNEWTONTRSETPOSTCHECK
     33:   #define snesnewtontrdcsetprecheck_       SNESNEWTONTRDCSETPRECHECK
     34:   #define snesnewtontrdcsetpostcheck_      SNESNEWTONTRDCSETPOSTCHECK
     35:   #define matmffdcomputejacobian_          MATMFFDCOMPUTEJACOBIAN
     36: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
     37:   #define snessetpicard_                   snessetpicard
     38:   #define snessetpicardnointerface_        snessetpicardnointerface
     39:   #define snessolve_                       snessolve
     40:   #define snescomputejacobiandefault_      snescomputejacobiandefault
     41:   #define snescomputejacobiandefaultcolor_ snescomputejacobiandefaultcolor
     42:   #define snessetjacobian_                 snessetjacobian
     43:   #define snessetjacobiannointerface_      snessetjacobiannointerface
     44:   #define snessetfunction_                 snessetfunction
     45:   #define snessetfunctionnointerface_      snessetfunctionnointerface
     46:   #define snessetobjective_                snessetobjective
     47:   #define snessetobjectivenointerface_     snessetobjectivenointerface
     48:   #define snessetngs_                      snessetngs
     49:   #define snessetupdate_                   snessetupdate
     50:   #define snesgetfunction_                 snesgetfunction
     51:   #define snesgetngs_                      snesgetngs
     52:   #define snessetconvergencetest_          snessetconvergencetest
     53:   #define snesconvergeddefault_            snesconvergeddefault
     54:   #define snesconvergedskip_               snesconvergedskip
     55:   #define snesgetjacobian_                 snesgetjacobian
     56:   #define snesgetconvergencehistory_       snesgetconvergencehistory
     57:   #define snesmonitordefault_              snesmonitordefault
     58:   #define snesmonitorsolution_             snesmonitorsolution
     59:   #define snesmonitorsolutionupdate_       snesmonitorsolutionupdate
     60:   #define snesmonitorset_                  snesmonitorset
     61:   #define snesnewtontrsetprecheck_         snesnewtontrsetprecheck
     62:   #define snesnewtontrsetpostcheck_        snesnewtontrsetpostcheck
     63:   #define snesnewtontrdcsetprecheck_       snesnewtontrdcsetprecheck
     64:   #define snesnewtontrdcsetpostcheck_      snesnewtontrdcsetpostcheck
     65:   #define matmffdcomputejacobian_          matmffdcomputejacobian
     66: #endif

     68: static struct {
     69:   PetscFortranCallbackId function;
     70:   PetscFortranCallbackId objective;
     71:   PetscFortranCallbackId test;
     72:   PetscFortranCallbackId destroy;
     73:   PetscFortranCallbackId jacobian;
     74:   PetscFortranCallbackId monitor;
     75:   PetscFortranCallbackId mondestroy;
     76:   PetscFortranCallbackId ngs;
     77:   PetscFortranCallbackId update;
     78:   PetscFortranCallbackId trprecheck;
     79:   PetscFortranCallbackId trpostcheck;
     80: #if defined(PETSC_HAVE_F90_2PTR_ARG)
     81:   PetscFortranCallbackId function_pgiptr;
     82:   PetscFortranCallbackId objective_pgiptr;
     83:   PetscFortranCallbackId trprecheck_pgiptr;
     84:   PetscFortranCallbackId trpostcheck_pgiptr;
     85: #endif
     86: } _cb;

     88: static PetscErrorCode ourtrprecheckfunction(SNES snes, Vec x, Vec y, PetscBool *changed_y, void *ctx)
     89: {
     90: #if defined(PETSC_HAVE_F90_2PTR_ARG)
     91:   void *ptr;
     92:   PetscCall(PetscObjectGetFortranCallback((PetscObject)snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.trprecheck_pgiptr, NULL, &ptr));
     93: #endif
     94:   PetscObjectUseFortranCallback(snes, _cb.trprecheck, (SNES *, Vec *, Vec *, PetscBool *, void *, PetscErrorCode *PETSC_F90_2PTR_PROTO_NOVAR), (&snes, &x, &y, changed_y, _ctx, &ierr PETSC_F90_2PTR_PARAM(ptr)));
     95: }

     97: PETSC_EXTERN void snesnewtontrsetprecheck_(SNES *snes, void (*func)(SNES, Vec, Vec, PetscBool *, void *), void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
     98: {
     99:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trprecheck, (PetscVoidFn *)func, ctx);
    100:   if (*ierr) return;
    101: #if defined(PETSC_HAVE_F90_2PTR_ARG)
    102:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trprecheck_pgiptr, NULL, ptr);
    103:   if (*ierr) return;
    104: #endif
    105:   *ierr = SNESNewtonTRSetPreCheck(*snes, ourtrprecheckfunction, NULL);
    106: }

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

    119: static PetscErrorCode ourtrpostcheckfunction(SNES snes, Vec x, Vec y, Vec w, PetscBool *changed_y, PetscBool *changed_w, void *ctx)
    120: {
    121: #if defined(PETSC_HAVE_F90_2PTR_ARG)
    122:   void *ptr;
    123:   PetscCall(PetscObjectGetFortranCallback((PetscObject)snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.trpostcheck_pgiptr, NULL, &ptr));
    124: #endif
    125:   PetscObjectUseFortranCallback(snes, _cb.trpostcheck, (SNES *, Vec *, Vec *, Vec *, PetscBool *, PetscBool *, void *, PetscErrorCode *PETSC_F90_2PTR_PROTO_NOVAR), (&snes, &x, &y, &w, changed_y, changed_w, _ctx, &ierr PETSC_F90_2PTR_PARAM(ptr)));
    126: }

    128: PETSC_EXTERN void snesnewtontrsetpostcheck_(SNES *snes, void (*func)(SNES, Vec, Vec, Vec, PetscBool *, PetscBool *, void *), void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
    129: {
    130:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trpostcheck, (PetscVoidFn *)func, ctx);
    131:   if (*ierr) return;
    132: #if defined(PETSC_HAVE_F90_2PTR_ARG)
    133:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trpostcheck_pgiptr, NULL, ptr);
    134:   if (*ierr) return;
    135: #endif
    136:   *ierr = SNESNewtonTRSetPostCheck(*snes, ourtrpostcheckfunction, NULL);
    137: }

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

    150: static PetscErrorCode oursnesfunction(SNES snes, Vec x, Vec f, void *ctx)
    151: {
    152: #if defined(PETSC_HAVE_F90_2PTR_ARG)
    153:   void *ptr;
    154:   PetscCall(PetscObjectGetFortranCallback((PetscObject)snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.function_pgiptr, NULL, &ptr));
    155: #endif
    156:   PetscObjectUseFortranCallback(snes, _cb.function, (SNES *, Vec *, Vec *, void *, PetscErrorCode *PETSC_F90_2PTR_PROTO_NOVAR), (&snes, &x, &f, _ctx, &ierr PETSC_F90_2PTR_PARAM(ptr)));
    157: }

    159: static PetscErrorCode oursnesobjective(SNES snes, Vec x, PetscReal *v, void *ctx)
    160: {
    161: #if defined(PETSC_HAVE_F90_2PTR_ARG)
    162:   void *ptr;
    163:   PetscCall(PetscObjectGetFortranCallback((PetscObject)snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.objective_pgiptr, NULL, &ptr));
    164: #endif
    165:   PetscObjectUseFortranCallback(snes, _cb.objective, (SNES *, Vec *, PetscReal *, void *, PetscErrorCode *PETSC_F90_2PTR_PROTO_NOVAR), (&snes, &x, v, _ctx, &ierr PETSC_F90_2PTR_PARAM(ptr)));
    166: }

    168: static PetscErrorCode oursnestest(SNES snes, PetscInt it, PetscReal a, PetscReal d, PetscReal c, SNESConvergedReason *reason, void *ctx)
    169: {
    170:   PetscObjectUseFortranCallback(snes, _cb.test, (SNES *, PetscInt *, PetscReal *, PetscReal *, PetscReal *, SNESConvergedReason *, void *, PetscErrorCode *), (&snes, &it, &a, &d, &c, reason, _ctx, &ierr));
    171: }

    173: static PetscErrorCode ourdestroy(void *ctx)
    174: {
    175:   PetscObjectUseFortranCallback(ctx, _cb.destroy, (void *, PetscErrorCode *), (_ctx, &ierr));
    176: }

    178: static PetscErrorCode oursnesjacobian(SNES snes, Vec x, Mat m, Mat p, void *ctx)
    179: {
    180:   PetscObjectUseFortranCallback(snes, _cb.jacobian, (SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&snes, &x, &m, &p, _ctx, &ierr));
    181: }

    183: static PetscErrorCode oursnesupdate(SNES snes, PetscInt i)
    184: {
    185:   PetscObjectUseFortranCallback(snes, _cb.update, (SNES *, PetscInt *, PetscErrorCode *), (&snes, &i, &ierr));
    186: }
    187: static PetscErrorCode oursnesngs(SNES snes, Vec x, Vec b, void *ctx)
    188: {
    189:   PetscObjectUseFortranCallback(snes, _cb.ngs, (SNES *, Vec *, Vec *, void *, PetscErrorCode *), (&snes, &x, &b, _ctx, &ierr));
    190: }
    191: static PetscErrorCode oursnesmonitor(SNES snes, PetscInt i, PetscReal d, void *ctx)
    192: {
    193:   PetscObjectUseFortranCallback(snes, _cb.monitor, (SNES *, PetscInt *, PetscReal *, void *, PetscErrorCode *), (&snes, &i, &d, _ctx, &ierr));
    194: }
    195: static PetscErrorCode ourmondestroy(void **ctx)
    196: {
    197:   SNES snes = (SNES)*ctx;
    198:   PetscObjectUseFortranCallback(snes, _cb.mondestroy, (void *, PetscErrorCode *), (_ctx, &ierr));
    199: }

    201: /* these are generated automatically by bfort */
    202: PETSC_EXTERN void snescomputejacobiandefault_(SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *);
    203: PETSC_EXTERN void snescomputejacobiandefaultcolor_(SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *);
    204: PETSC_EXTERN void matmffdcomputejacobian_(SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *);

    206: PETSC_EXTERN void snessetjacobian_(SNES *snes, Mat *A, Mat *B, SNESJacobianFn func, void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
    207: {
    208:   CHKFORTRANNULLFUNCTION(func);
    209:   if ((PetscVoidFn *)func == (PetscVoidFn *)snescomputejacobiandefault_) {
    210:     *ierr = SNESSetJacobian(*snes, *A, *B, SNESComputeJacobianDefault, ctx);
    211:   } else if ((PetscVoidFn *)func == (PetscVoidFn *)snescomputejacobiandefaultcolor_) {
    212:     if (!ctx) {
    213:       *ierr = PETSC_ERR_ARG_NULL;
    214:       return;
    215:     }
    216:     *ierr = SNESSetJacobian(*snes, *A, *B, SNESComputeJacobianDefaultColor, *(MatFDColoring *)ctx);
    217:   } else if ((PetscVoidFn *)func == (PetscVoidFn *)matmffdcomputejacobian_) {
    218:     *ierr = SNESSetJacobian(*snes, *A, *B, MatMFFDComputeJacobian, ctx);
    219:   } else {
    220:     *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.jacobian, (PetscVoidFn *)func, ctx);
    221:     if (!*ierr) *ierr = SNESSetJacobian(*snes, *A, *B, oursnesjacobian, NULL);
    222:   }
    223: }

    225: PETSC_EXTERN void snessetjacobiannointerface_(SNES *snes, Mat *A, Mat *B, SNESJacobianFn J, void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
    226: {
    227:   snessetjacobian_(snes, A, B, J, ctx, ierr PETSC_F90_2PTR_PARAM(ptr));
    228: }

    230: /*  func is currently ignored from Fortran */
    231: PETSC_EXTERN void snesgetjacobian_(SNES *snes, Mat *A, Mat *B, int *func, void **ctx, PetscErrorCode *ierr)
    232: {
    233:   SNESJacobianFn *jfunc;
    234:   void           *jctx;

    236:   CHKFORTRANNULL(ctx);
    237:   CHKFORTRANNULLOBJECT(A);
    238:   CHKFORTRANNULLOBJECT(B);
    239:   *ierr = SNESGetJacobian(*snes, A, B, &jfunc, &jctx);
    240:   if (*ierr) return;
    241:   if (jfunc == SNESComputeJacobianDefault || jfunc == SNESComputeJacobianDefaultColor || jfunc == MatMFFDComputeJacobian) {
    242:     if (ctx) *ctx = jctx;
    243:   } else {
    244:     *ierr = PetscObjectGetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.jacobian, NULL, ctx);
    245:   }
    246: }

    248: static PetscErrorCode oursnespicardfunction(SNES snes, Vec x, Vec f, void *ctx)
    249: {
    250: #if defined(PETSC_HAVE_F90_2PTR_ARG)
    251:   void *ptr;
    252:   PetscCall(PetscObjectGetFortranCallback((PetscObject)snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.function_pgiptr, NULL, &ptr));
    253: #endif
    254:   PetscObjectUseFortranCallback(snes, _cb.function, (SNES *, Vec *, Vec *, void *, PetscErrorCode *PETSC_F90_2PTR_PROTO_NOVAR), (&snes, &x, &f, _ctx, &ierr PETSC_F90_2PTR_PARAM(ptr)));
    255: }

    257: static PetscErrorCode oursnespicardjacobian(SNES snes, Vec x, Mat m, Mat p, void *ctx)
    258: {
    259:   PetscObjectUseFortranCallback(snes, _cb.jacobian, (SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&snes, &x, &m, &p, _ctx, &ierr));
    260: }

    262: PETSC_EXTERN void snessetpicard_(SNES *snes, Vec *r, SNESFunctionFn func, Mat *A, Mat *B, SNESJacobianFn J, void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
    263: {
    264:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.function, (PetscVoidFn *)func, ctx);
    265: #if defined(PETSC_HAVE_F90_2PTR_ARG)
    266:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.function_pgiptr, NULL, ptr);
    267:   if (*ierr) return;
    268: #endif
    269:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.jacobian, (PetscVoidFn *)J, ctx);
    270:   if (!*ierr) *ierr = SNESSetPicard(*snes, *r, oursnespicardfunction, *A, *B, oursnespicardjacobian, NULL);
    271: }

    273: PETSC_EXTERN void snessetpicardnointerface_(SNES *snes, Vec *r, SNESFunctionFn func, Mat *A, Mat *B, SNESJacobianFn J, void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
    274: {
    275:   snessetpicard_(snes, r, func, A, B, J, ctx, ierr PETSC_F90_2PTR_PARAM(ptr));
    276: }

    278: /*
    279:    These are not usually called from Fortran but allow Fortran users
    280:    to transparently set these monitors from .F code
    281: */

    283: PETSC_EXTERN void snessetfunction_(SNES *snes, Vec *r, SNESFunctionFn func, void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
    284: {
    285:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.function, (PetscVoidFn *)func, ctx);
    286:   if (*ierr) return;
    287: #if defined(PETSC_HAVE_F90_2PTR_ARG)
    288:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.function_pgiptr, NULL, ptr);
    289:   if (*ierr) return;
    290: #endif
    291:   *ierr = SNESSetFunction(*snes, *r, oursnesfunction, NULL);
    292: }

    294: PETSC_EXTERN void snessetfunctionnointerface_(SNES *snes, Vec *r, SNESFunctionFn func, void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
    295: {
    296:   snessetfunction_(snes, r, func, ctx, ierr PETSC_F90_2PTR_PARAM(ptr));
    297: }

    299: PETSC_EXTERN void snessetobjective_(SNES *snes, SNESObjectiveFn func, void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
    300: {
    301:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.objective, (PetscVoidFn *)func, ctx);
    302:   if (*ierr) return;
    303: #if defined(PETSC_HAVE_F90_2PTR_ARG)
    304:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.objective_pgiptr, NULL, ptr);
    305:   if (*ierr) return;
    306: #endif
    307:   *ierr = SNESSetObjective(*snes, oursnesobjective, NULL);
    308: }

    310: PETSC_EXTERN void snessetobjectivenointerface_(SNES *snes, SNESObjectiveFn func, void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
    311: {
    312:   snessetobjective_(snes, func, ctx, ierr PETSC_F90_2PTR_PARAM(ptr));
    313: }

    315: PETSC_EXTERN void snessetngs_(SNES *snes, void (*func)(SNES *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
    316: {
    317:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.ngs, (PetscVoidFn *)func, ctx);
    318:   if (*ierr) return;
    319:   *ierr = SNESSetNGS(*snes, oursnesngs, NULL);
    320: }
    321: PETSC_EXTERN void snessetupdate_(SNES *snes, void (*func)(SNES *, PetscInt *, PetscErrorCode *), PetscErrorCode *ierr)
    322: {
    323:   *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.update, (PetscVoidFn *)func, NULL);
    324:   if (*ierr) return;
    325:   *ierr = SNESSetUpdate(*snes, oursnesupdate);
    326: }

    328: /* the func argument is ignored */
    329: PETSC_EXTERN void snesgetfunction_(SNES *snes, Vec *r, SNESFunctionFn func, void **ctx, PetscErrorCode *ierr)
    330: {
    331:   CHKFORTRANNULLOBJECT(r);
    332:   *ierr = SNESGetFunction(*snes, r, NULL, NULL);
    333:   if (*ierr) return;
    334:   if ((PetscVoidFn *)func == (PetscVoidFn *)PETSC_NULL_FUNCTION_Fortran) return;
    335:   *ierr = PetscObjectGetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.function, NULL, ctx);
    336: }

    338: PETSC_EXTERN void snesgetngs_(SNES *snes, void *func, void **ctx, PetscErrorCode *ierr)
    339: {
    340:   *ierr = PetscObjectGetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.ngs, NULL, ctx);
    341: }

    343: PETSC_EXTERN void snesconvergeddefault_(SNES *snes, PetscInt *it, PetscReal *a, PetscReal *b, PetscReal *c, SNESConvergedReason *r, void *ct, PetscErrorCode *ierr)
    344: {
    345:   *ierr = SNESConvergedDefault(*snes, *it, *a, *b, *c, r, ct);
    346: }

    348: PETSC_EXTERN void snesconvergedskip_(SNES *snes, PetscInt *it, PetscReal *a, PetscReal *b, PetscReal *c, SNESConvergedReason *r, void *ct, PetscErrorCode *ierr)
    349: {
    350:   *ierr = SNESConvergedSkip(*snes, *it, *a, *b, *c, r, ct);
    351: }

    353: PETSC_EXTERN void snessetconvergencetest_(SNES *snes, void (*func)(SNES *, PetscInt *, PetscReal *, PetscReal *, PetscReal *, SNESConvergedReason *, void *, PetscErrorCode *), void *cctx, void (*destroy)(void *), PetscErrorCode *ierr)
    354: {
    355:   CHKFORTRANNULLFUNCTION(destroy);

    357:   if ((PetscVoidFn *)func == (PetscVoidFn *)snesconvergeddefault_) {
    358:     *ierr = SNESSetConvergenceTest(*snes, SNESConvergedDefault, NULL, NULL);
    359:   } else if ((PetscVoidFn *)func == (PetscVoidFn *)snesconvergedskip_) {
    360:     *ierr = SNESSetConvergenceTest(*snes, SNESConvergedSkip, NULL, NULL);
    361:   } else {
    362:     *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.test, (PetscVoidFn *)func, cctx);
    363:     if (*ierr) return;
    364:     *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.destroy, (PetscVoidFn *)destroy, cctx);
    365:     if (*ierr) return;
    366:     *ierr = SNESSetConvergenceTest(*snes, oursnestest, *snes, ourdestroy);
    367:   }
    368: }

    370: PETSC_EXTERN void snesgetconvergencehistory_(SNES *snes, PetscInt *na, PetscErrorCode *ierr)
    371: {
    372:   *ierr = SNESGetConvergenceHistory(*snes, NULL, NULL, na);
    373: }

    375: PETSC_EXTERN void snesmonitordefault_(SNES *snes, PetscInt *its, PetscReal *fgnorm, PetscViewerAndFormat **dummy, PetscErrorCode *ierr)
    376: {
    377:   *ierr = SNESMonitorDefault(*snes, *its, *fgnorm, *dummy);
    378: }

    380: PETSC_EXTERN void snesmonitorsolution_(SNES *snes, PetscInt *its, PetscReal *fgnorm, PetscViewerAndFormat **dummy, PetscErrorCode *ierr)
    381: {
    382:   *ierr = SNESMonitorSolution(*snes, *its, *fgnorm, *dummy);
    383: }

    385: PETSC_EXTERN void snesmonitorsolutionupdate_(SNES *snes, PetscInt *its, PetscReal *fgnorm, PetscViewerAndFormat **dummy, PetscErrorCode *ierr)
    386: {
    387:   *ierr = SNESMonitorSolutionUpdate(*snes, *its, *fgnorm, *dummy);
    388: }

    390: PETSC_EXTERN void snesmonitorset_(SNES *snes, void (*func)(SNES *, PetscInt *, PetscReal *, void *, PetscErrorCode *), void *mctx, void (*mondestroy)(void *, PetscErrorCode *), PetscErrorCode *ierr)
    391: {
    392:   CHKFORTRANNULLFUNCTION(mondestroy);
    393:   if ((PetscVoidFn *)func == (PetscVoidFn *)snesmonitordefault_) {
    394:     *ierr = SNESMonitorSet(*snes, (PetscErrorCode (*)(SNES, PetscInt, PetscReal, void *))SNESMonitorDefault, *(PetscViewerAndFormat **)mctx, (PetscErrorCode (*)(void **))PetscViewerAndFormatDestroy);
    395:   } else if ((PetscVoidFn *)func == (PetscVoidFn *)snesmonitorsolution_) {
    396:     *ierr = SNESMonitorSet(*snes, (PetscErrorCode (*)(SNES, PetscInt, PetscReal, void *))SNESMonitorSolution, *(PetscViewerAndFormat **)mctx, (PetscErrorCode (*)(void **))PetscViewerAndFormatDestroy);
    397:   } else if ((PetscVoidFn *)func == (PetscVoidFn *)snesmonitorsolutionupdate_) {
    398:     *ierr = SNESMonitorSet(*snes, (PetscErrorCode (*)(SNES, PetscInt, PetscReal, void *))SNESMonitorSolutionUpdate, *(PetscViewerAndFormat **)mctx, (PetscErrorCode (*)(void **))PetscViewerAndFormatDestroy);
    399:   } else {
    400:     *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.monitor, (PetscVoidFn *)func, mctx);
    401:     if (*ierr) return;
    402:     *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.mondestroy, (PetscVoidFn *)mondestroy, mctx);
    403:     if (*ierr) return;
    404:     *ierr = SNESMonitorSet(*snes, oursnesmonitor, *snes, ourmondestroy);
    405:   }
    406: }