16dd63270SBarry Smith #include <petsc/private/ftnimpl.h> 2af0996ceSBarry Smith #include <petsc/private/snesimpl.h> 3382167b7SJed Brown #if defined(PETSC_HAVE_FORTRAN_CAPS) 4382167b7SJed Brown #define dmsnessetjacobian_ DMSNESSETJACOBIAN 5382167b7SJed Brown #define dmsnessetfunction_ DMSNESSETFUNCTION 6382167b7SJed Brown #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 7382167b7SJed Brown #define dmsnessetjacobian_ dmsnessetjacobian 8382167b7SJed Brown #define dmsnessetfunction_ dmsnessetfunction 9382167b7SJed Brown #endif 10382167b7SJed Brown 11382167b7SJed Brown static struct { 12382167b7SJed Brown PetscFortranCallbackId snesfunction; 13382167b7SJed Brown PetscFortranCallbackId snesjacobian; 14382167b7SJed Brown } _cb; 15382167b7SJed Brown 16d1e9a80fSBarry Smith static PetscErrorCode ourj(SNES snes, Vec X, Mat J, Mat P, void *ptr) 17382167b7SJed Brown { 1819caf8f3SSatish Balay void (*func)(SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), *ctx; 19382167b7SJed Brown DM dm; 20382167b7SJed Brown DMSNES sdm; 21382167b7SJed Brown 22382167b7SJed Brown PetscFunctionBegin; 239566063dSJacob Faibussowitsch PetscCall(SNESGetDM(snes, &dm)); 249566063dSJacob Faibussowitsch PetscCall(DMGetDMSNES(dm, &sdm)); 25*5ebfa9e9SBarry Smith PetscCall(PetscObjectGetFortranCallback((PetscObject)sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, _cb.snesjacobian, (PetscFortranCallbackFn **)&func, &ctx)); 269566063dSJacob Faibussowitsch PetscCallFortranVoidFunction((*func)(&snes, &X, &J, &P, ctx, &ierr)); 273ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 28382167b7SJed Brown } 29382167b7SJed Brown 3019caf8f3SSatish Balay PETSC_EXTERN void dmsnessetjacobian_(DM *dm, void (*jac)(DM *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 31382167b7SJed Brown { 32382167b7SJed Brown DMSNES sdm; 33382167b7SJed Brown 345975b3b6SBarry Smith *ierr = DMGetDMSNESWrite(*dm, &sdm); 355975b3b6SBarry Smith if (*ierr) return; 36*5ebfa9e9SBarry Smith *ierr = PetscObjectSetFortranCallback((PetscObject)sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.snesjacobian, (PetscFortranCallbackFn *)jac, ctx); 375975b3b6SBarry Smith if (*ierr) return; 38382167b7SJed Brown *ierr = DMSNESSetJacobian(*dm, ourj, NULL); 39382167b7SJed Brown } 40382167b7SJed Brown 41382167b7SJed Brown static PetscErrorCode ourf(SNES snes, Vec X, Vec F, void *ptr) 42382167b7SJed Brown { 4319caf8f3SSatish Balay void (*func)(SNES *, Vec *, Vec *, void *, PetscErrorCode *), *ctx; 44382167b7SJed Brown DM dm; 45382167b7SJed Brown DMSNES sdm; 46382167b7SJed Brown 47382167b7SJed Brown PetscFunctionBegin; 489566063dSJacob Faibussowitsch PetscCall(SNESGetDM(snes, &dm)); 499566063dSJacob Faibussowitsch PetscCall(DMGetDMSNES(dm, &sdm)); 50*5ebfa9e9SBarry Smith PetscCall(PetscObjectGetFortranCallback((PetscObject)sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, _cb.snesfunction, (PetscFortranCallbackFn **)&func, &ctx)); 519566063dSJacob Faibussowitsch PetscCallFortranVoidFunction((*func)(&snes, &X, &F, ctx, &ierr)); 523ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 53382167b7SJed Brown } 54382167b7SJed Brown 5519caf8f3SSatish Balay PETSC_EXTERN void dmsnessetfunction_(DM *dm, void (*func)(SNES *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 56382167b7SJed Brown { 57382167b7SJed Brown DMSNES sdm; 58382167b7SJed Brown 595975b3b6SBarry Smith *ierr = DMGetDMSNESWrite(*dm, &sdm); 605975b3b6SBarry Smith if (*ierr) return; 61*5ebfa9e9SBarry Smith *ierr = PetscObjectSetFortranCallback((PetscObject)sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.snesfunction, (PetscFortranCallbackFn *)func, ctx); 625975b3b6SBarry Smith if (*ierr) return; 63382167b7SJed Brown *ierr = DMSNESSetFunction(*dm, ourf, NULL); 64382167b7SJed Brown } 65