1a63a1bedSMatthew G. Knepley #include <petsc-private/fortranimpl.h> 2a63a1bedSMatthew G. Knepley #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 16a63a1bedSMatthew G. Knepley #undef __FUNCT__ 17a63a1bedSMatthew G. Knepley #define __FUNCT__ "sourlj" 18*d1e9a80fSBarry Smith static PetscErrorCode sourlj(DM dm, Vec X, Mat J, Mat P, void *ptr) 19a63a1bedSMatthew G. Knepley { 20a63a1bedSMatthew G. Knepley PetscErrorCode ierr; 21*d1e9a80fSBarry Smith void (PETSC_STDCALL *func)(DM*,Vec*,Mat*,Mat*,void*,PetscErrorCode*),*ctx; 22a63a1bedSMatthew G. Knepley DMSNES sdm; 23a63a1bedSMatthew G. Knepley 24a63a1bedSMatthew G. Knepley PetscFunctionBegin; 25a63a1bedSMatthew G. Knepley ierr = DMGetDMSNES(dm, &sdm);CHKERRQ(ierr); 26a63a1bedSMatthew G. Knepley ierr = PetscObjectGetFortranCallback((PetscObject) sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, _cb.lj, (PetscVoidFunction *) &func, &ctx);CHKERRQ(ierr); 27*d1e9a80fSBarry Smith (*func)(&dm, &X, &J, &P, ctx, &ierr);CHKERRQ(ierr); 28a63a1bedSMatthew G. Knepley PetscFunctionReturn(0); 29a63a1bedSMatthew G. Knepley } 30a63a1bedSMatthew G. Knepley 31*d1e9a80fSBarry Smith PETSC_EXTERN void PETSC_STDCALL dmsnessetjacobianlocal_(DM *dm, void (PETSC_STDCALL *jac)(DM*,Vec*,Mat*,Mat*,void*,PetscErrorCode*), void *ctx, PetscErrorCode *ierr) 32a63a1bedSMatthew G. Knepley { 33a63a1bedSMatthew G. Knepley DMSNES sdm; 34a63a1bedSMatthew G. Knepley 35a63a1bedSMatthew G. Knepley *ierr = DMGetDMSNESWrite(*dm, &sdm); if (*ierr) return; 36a63a1bedSMatthew G. Knepley *ierr = PetscObjectSetFortranCallback((PetscObject) sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.lj, (PetscVoidFunction) jac, ctx); if (*ierr) return; 37430b4d03SJed Brown *ierr = DMSNESSetJacobianLocal(*dm, sourlj, NULL); 38a63a1bedSMatthew G. Knepley } 39a63a1bedSMatthew G. Knepley 40a63a1bedSMatthew G. Knepley #undef __FUNCT__ 41a63a1bedSMatthew G. Knepley #define __FUNCT__ "sourlf" 42a63a1bedSMatthew G. Knepley static PetscErrorCode sourlf(DM dm, Vec X, Vec F, void *ptr) 43a63a1bedSMatthew G. Knepley { 44a63a1bedSMatthew G. Knepley PetscErrorCode ierr; 45a63a1bedSMatthew G. Knepley void (PETSC_STDCALL *func)(DM*,Vec*,Vec*,void*,PetscErrorCode*), *ctx; 46a63a1bedSMatthew G. Knepley DMSNES sdm; 47a63a1bedSMatthew G. Knepley 48a63a1bedSMatthew G. Knepley PetscFunctionBegin; 49a63a1bedSMatthew G. Knepley ierr = DMGetDMSNES(dm, &sdm);CHKERRQ(ierr); 50a63a1bedSMatthew G. Knepley ierr = PetscObjectGetFortranCallback((PetscObject) sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, _cb.lf, (PetscVoidFunction *) &func, &ctx);CHKERRQ(ierr); 51a63a1bedSMatthew G. Knepley (*func)(&dm, &X, &F, ctx, &ierr);CHKERRQ(ierr); 52a63a1bedSMatthew G. Knepley PetscFunctionReturn(0); 53a63a1bedSMatthew G. Knepley } 54a63a1bedSMatthew G. Knepley 55a63a1bedSMatthew G. Knepley PETSC_EXTERN void PETSC_STDCALL dmsnessetfunctionlocal_(DM *dm, void (PETSC_STDCALL *func)(DM*,Vec*,Vec*,void*,PetscErrorCode*), void *ctx, PetscErrorCode *ierr) 56a63a1bedSMatthew G. Knepley { 57a63a1bedSMatthew G. Knepley DMSNES sdm; 58a63a1bedSMatthew G. Knepley 59a63a1bedSMatthew G. Knepley *ierr = DMGetDMSNESWrite(*dm, &sdm); if (*ierr) return; 60a63a1bedSMatthew G. Knepley *ierr = PetscObjectSetFortranCallback((PetscObject) sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.lf, (PetscVoidFunction) func, ctx); if (*ierr) return; 61430b4d03SJed Brown *ierr = DMSNESSetFunctionLocal(*dm, sourlf, NULL); 62a63a1bedSMatthew G. Knepley } 63