1*a63a1bedSMatthew G. Knepley #include <petsc-private/fortranimpl.h> 2*a63a1bedSMatthew G. Knepley #include <petsc-private/snesimpl.h> 3*a63a1bedSMatthew G. Knepley #if defined(PETSC_HAVE_FORTRAN_CAPS) 4*a63a1bedSMatthew G. Knepley #define dmsnessetjacobianlocal_ DMSNESSETJACOBIANLOCAL 5*a63a1bedSMatthew G. Knepley #define dmsnessetfunctionlocal_ DMSNESSETFUNCTIONLOCAL 6*a63a1bedSMatthew G. Knepley #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 7*a63a1bedSMatthew G. Knepley #define dmsnessetjacobianlocal_ dmsnessetjacobianlocal 8*a63a1bedSMatthew G. Knepley #define dmsnessetfunctionlocal_ dmsnessetfunctionlocal 9*a63a1bedSMatthew G. Knepley #endif 10*a63a1bedSMatthew G. Knepley 11*a63a1bedSMatthew G. Knepley static struct { 12*a63a1bedSMatthew G. Knepley PetscFortranCallbackId lf; 13*a63a1bedSMatthew G. Knepley PetscFortranCallbackId lj; 14*a63a1bedSMatthew G. Knepley } _cb; 15*a63a1bedSMatthew G. Knepley 16*a63a1bedSMatthew G. Knepley #undef __FUNCT__ 17*a63a1bedSMatthew G. Knepley #define __FUNCT__ "sourlj" 18*a63a1bedSMatthew G. Knepley static PetscErrorCode sourlj(DM dm, Vec X, Mat J, Mat P, MatStructure *str, void *ptr) 19*a63a1bedSMatthew G. Knepley { 20*a63a1bedSMatthew G. Knepley PetscErrorCode ierr; 21*a63a1bedSMatthew G. Knepley void (PETSC_STDCALL *func)(DM*,Vec*,Mat*,Mat*,MatStructure*,void*,PetscErrorCode*),*ctx; 22*a63a1bedSMatthew G. Knepley DMSNES sdm; 23*a63a1bedSMatthew G. Knepley 24*a63a1bedSMatthew G. Knepley PetscFunctionBegin; 25*a63a1bedSMatthew G. Knepley ierr = DMGetDMSNES(dm, &sdm);CHKERRQ(ierr); 26*a63a1bedSMatthew G. Knepley ierr = PetscObjectGetFortranCallback((PetscObject) sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, _cb.lj, (PetscVoidFunction *) &func, &ctx);CHKERRQ(ierr); 27*a63a1bedSMatthew G. Knepley (*func)(&dm, &X, &J, &P, str, ctx, &ierr);CHKERRQ(ierr); 28*a63a1bedSMatthew G. Knepley PetscFunctionReturn(0); 29*a63a1bedSMatthew G. Knepley } 30*a63a1bedSMatthew G. Knepley 31*a63a1bedSMatthew G. Knepley PETSC_EXTERN void PETSC_STDCALL dmsnessetjacobianlocal_(DM *dm, void (PETSC_STDCALL *jac)(DM*,void*,void*,void*,void*,void*,PetscErrorCode*), void *ctx, PetscErrorCode *ierr) 32*a63a1bedSMatthew G. Knepley { 33*a63a1bedSMatthew G. Knepley DMSNES sdm; 34*a63a1bedSMatthew G. Knepley 35*a63a1bedSMatthew G. Knepley *ierr = DMGetDMSNESWrite(*dm, &sdm); if (*ierr) return; 36*a63a1bedSMatthew G. Knepley *ierr = PetscObjectSetFortranCallback((PetscObject) sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.lj, (PetscVoidFunction) jac, ctx); if (*ierr) return; 37*a63a1bedSMatthew G. Knepley *ierr = DMSNESSetJacobianLocal(*dm, (PetscErrorCode (*)(DM,Vec,Mat,Mat,MatStructure*,void*)) sourlj, NULL); 38*a63a1bedSMatthew G. Knepley } 39*a63a1bedSMatthew G. Knepley 40*a63a1bedSMatthew G. Knepley #undef __FUNCT__ 41*a63a1bedSMatthew G. Knepley #define __FUNCT__ "sourlf" 42*a63a1bedSMatthew G. Knepley static PetscErrorCode sourlf(DM dm, Vec X, Vec F, void *ptr) 43*a63a1bedSMatthew G. Knepley { 44*a63a1bedSMatthew G. Knepley PetscErrorCode ierr; 45*a63a1bedSMatthew G. Knepley void (PETSC_STDCALL *func)(DM*,Vec*,Vec*,void*,PetscErrorCode*), *ctx; 46*a63a1bedSMatthew G. Knepley DMSNES sdm; 47*a63a1bedSMatthew G. Knepley 48*a63a1bedSMatthew G. Knepley PetscFunctionBegin; 49*a63a1bedSMatthew G. Knepley ierr = DMGetDMSNES(dm, &sdm);CHKERRQ(ierr); 50*a63a1bedSMatthew G. Knepley ierr = PetscObjectGetFortranCallback((PetscObject) sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, _cb.lf, (PetscVoidFunction *) &func, &ctx);CHKERRQ(ierr); 51*a63a1bedSMatthew G. Knepley (*func)(&dm, &X, &F, ctx, &ierr);CHKERRQ(ierr); 52*a63a1bedSMatthew G. Knepley PetscFunctionReturn(0); 53*a63a1bedSMatthew G. Knepley } 54*a63a1bedSMatthew G. Knepley 55*a63a1bedSMatthew G. Knepley PETSC_EXTERN void PETSC_STDCALL dmsnessetfunctionlocal_(DM *dm, void (PETSC_STDCALL *func)(DM*,Vec*,Vec*,void*,PetscErrorCode*), void *ctx, PetscErrorCode *ierr) 56*a63a1bedSMatthew G. Knepley { 57*a63a1bedSMatthew G. Knepley DMSNES sdm; 58*a63a1bedSMatthew G. Knepley 59*a63a1bedSMatthew G. Knepley *ierr = DMGetDMSNESWrite(*dm, &sdm); if (*ierr) return; 60*a63a1bedSMatthew G. Knepley *ierr = PetscObjectSetFortranCallback((PetscObject) sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.lf, (PetscVoidFunction) func, ctx); if (*ierr) return; 61*a63a1bedSMatthew G. Knepley *ierr = DMSNESSetFunctionLocal(*dm, (PetscErrorCode (*)(DM,Vec,Vec,void*))sourlf, NULL); 62*a63a1bedSMatthew G. Knepley } 63