For example
static PetscErrorCode oursnesfunction(SNES snes,Vec x,Vec f,void *ctx)
{
PetscObjectUseFortranCallback(snes,_cb.function,(SNES*,Vec*,Vec*,void*,PetscErrorCode*),(&snes,&x,&f,_ctx,&ierr));
return 0;
}
with
#define PetscObjectAllocateFortranPointers(obj,N) do { \
if (!((PetscObject)(obj))->fortran_func_pointers) { \
*ierr =
PetscMalloc((N)*sizeof(void(*)(void)),&((PetscObject)(obj))->fortran_func_pointers);if
(*ierr) return; \
*ierr =
PetscMemzero(((PetscObject)(obj))->fortran_func_pointers,(N)*sizeof(void(*)(void)));if
(*ierr) return; \
((PetscObject)obj)->num_fortran_func_pointers = (N); \
} \
} while (0)
/* Entire function body, _ctx is a "special" variable that can be passed along
*/
#define PetscObjectUseFortranCallback_Private(obj,cid,types,args,cbclass) { \
PetscErrorCode ierr; \
void (PETSC_STDCALL *func) types,*_ctx; \
PetscFunctionBegin; \
ierr =
PetscObjectGetFortranCallback((PetscObject)(obj),(cbclass),(cid),(PetscVoidFunction*)&func,&_ctx);CHKERRQ(ierr);
\
(*func)args;CHKERRQ(ierr); \
PetscFunctionReturn(0); \
}
#define PetscObjectUseFortranCallback(obj,cid,types,args)
PetscObjectUseFortranCallback_Private(obj,cid,types,args,PETSC_FORTRAN_CALLBACK_CLASS)
#define PetscObjectUseFortranCallbackSubType(obj,cid,types,args)
PetscObjectUseFortranCallback_Private(obj,cid,types,args,PETSC_FORTRAN_CALLBACK_SUBTYPE)
But any function with PetscFunctionBegin/Return needs to have
#undef __FUNCT__
#define __FUNCT__
so most of the fortran stubs are broken with error messages about wrong
function names.
Does anyone test before they push anymore :-)?
Barry