16dd63270SBarry Smith #include <petsc/private/ftnimpl.h> 2af0996ceSBarry Smith #include <petsc/private/snesimpl.h> 3a63a1bedSMatthew G. Knepley #if defined(PETSC_HAVE_FORTRAN_CAPS) 4a63a1bedSMatthew G. Knepley #define dmsnessetjacobianlocal_ DMSNESSETJACOBIANLOCAL 5a63a1bedSMatthew G. Knepley #define dmsnessetfunctionlocal_ DMSNESSETFUNCTIONLOCAL 6a63a1bedSMatthew G. Knepley #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 7a63a1bedSMatthew G. Knepley #define dmsnessetjacobianlocal_ dmsnessetjacobianlocal 8a63a1bedSMatthew G. Knepley #define dmsnessetfunctionlocal_ dmsnessetfunctionlocal 9a63a1bedSMatthew G. Knepley #endif 10a63a1bedSMatthew G. Knepley 11a63a1bedSMatthew G. Knepley static struct { 12a63a1bedSMatthew G. Knepley PetscFortranCallbackId lf; 13a63a1bedSMatthew G. Knepley PetscFortranCallbackId lj; 14a63a1bedSMatthew G. Knepley } _cb; 15a63a1bedSMatthew G. Knepley 16d1e9a80fSBarry Smith static PetscErrorCode sourlj(DM dm, Vec X, Mat J, Mat P, void *ptr) 17a63a1bedSMatthew G. Knepley { 1819caf8f3SSatish Balay void (*func)(DM *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), *ctx; 19a63a1bedSMatthew G. Knepley DMSNES sdm; 20a63a1bedSMatthew G. Knepley 21a63a1bedSMatthew G. Knepley PetscFunctionBegin; 229566063dSJacob Faibussowitsch PetscCall(DMGetDMSNES(dm, &sdm)); 23*5ebfa9e9SBarry Smith PetscCall(PetscObjectGetFortranCallback((PetscObject)sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, _cb.lj, (PetscFortranCallbackFn **)&func, &ctx)); 249566063dSJacob Faibussowitsch PetscCallFortranVoidFunction((*func)(&dm, &X, &J, &P, ctx, &ierr)); 253ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 26a63a1bedSMatthew G. Knepley } 27a63a1bedSMatthew G. Knepley 2819caf8f3SSatish Balay PETSC_EXTERN void dmsnessetjacobianlocal_(DM *dm, void (*jac)(DM *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 29a63a1bedSMatthew G. Knepley { 30a63a1bedSMatthew G. Knepley DMSNES sdm; 31a63a1bedSMatthew G. Knepley 325975b3b6SBarry Smith *ierr = DMGetDMSNESWrite(*dm, &sdm); 335975b3b6SBarry Smith if (*ierr) return; 34*5ebfa9e9SBarry Smith *ierr = PetscObjectSetFortranCallback((PetscObject)sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.lj, (PetscFortranCallbackFn *)jac, ctx); 355975b3b6SBarry Smith if (*ierr) return; 36430b4d03SJed Brown *ierr = DMSNESSetJacobianLocal(*dm, sourlj, NULL); 37a63a1bedSMatthew G. Knepley } 38a63a1bedSMatthew G. Knepley 39a63a1bedSMatthew G. Knepley static PetscErrorCode sourlf(DM dm, Vec X, Vec F, void *ptr) 40a63a1bedSMatthew G. Knepley { 4119caf8f3SSatish Balay void (*func)(DM *, Vec *, Vec *, void *, PetscErrorCode *), *ctx; 42a63a1bedSMatthew G. Knepley DMSNES sdm; 43a63a1bedSMatthew G. Knepley 44a63a1bedSMatthew G. Knepley PetscFunctionBegin; 459566063dSJacob Faibussowitsch PetscCall(DMGetDMSNES(dm, &sdm)); 46*5ebfa9e9SBarry Smith PetscCall(PetscObjectGetFortranCallback((PetscObject)sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, _cb.lf, (PetscFortranCallbackFn **)&func, &ctx)); 479566063dSJacob Faibussowitsch PetscCallFortranVoidFunction((*func)(&dm, &X, &F, ctx, &ierr)); 483ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 49a63a1bedSMatthew G. Knepley } 50a63a1bedSMatthew G. Knepley 5119caf8f3SSatish Balay PETSC_EXTERN void dmsnessetfunctionlocal_(DM *dm, void (*func)(DM *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 52a63a1bedSMatthew G. Knepley { 53a63a1bedSMatthew G. Knepley DMSNES sdm; 54a63a1bedSMatthew G. Knepley 555975b3b6SBarry Smith *ierr = DMGetDMSNESWrite(*dm, &sdm); 565975b3b6SBarry Smith if (*ierr) return; 57*5ebfa9e9SBarry Smith *ierr = PetscObjectSetFortranCallback((PetscObject)sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.lf, (PetscFortranCallbackFn *)func, ctx); 585975b3b6SBarry Smith if (*ierr) return; 59430b4d03SJed Brown *ierr = DMSNESSetFunctionLocal(*dm, sourlf, NULL); 60a63a1bedSMatthew G. Knepley } 61