[petsc-dev] new Fortran function pointer stuff broken

Barry Smith bsmith at mcs.anl.gov
Wed Feb 6 22:02:39 CST 2013


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




More information about the petsc-dev mailing list