#include #include /*I "petscdmshell.h" I*/ #if defined(PETSC_HAVE_FORTRAN_CAPS) #define dmshellsetcreatematrix_ DMSHELLSETCREATEMATRIX #define dmshellsetcreateglobalvector_ DMSHELLSETCREATEGLOBALVECTOR_ #define dmshellsetcreatelocalvector_ DMSHELLSETCREATELOCALVECTOR_ #define dmshellsetglobaltolocal_ DMSHELLSETGLOBALTOLOCAL_ #define dmshellsetlocaltoglobal_ DMSHELLSETLOCALTOGLOBAL_ #define dmshellsetlocaltolocal_ DMSHELLSETLOCALTOLOCAL_ #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) #define dmshellsetcreatematrix_ dmshellsetcreatematrix #define dmshellsetcreateglobalvector_ dmshellsetcreateglobalvector #define dmshellsetcreatelocalvector_ dmshellsetcreatelocalvector #define dmshellsetglobaltolocal_ dmshellsetglobaltolocal #define dmshellsetlocaltoglobal_ dmshellsetlocaltoglobal #define dmshellsetlocaltolocal_ dmshellsetlocaltolocal_ #endif /* * C routines are required for matrix and global vector creation. We define C routines here that call the corresponding * Fortran routine (indexed by _cb) that was set by the user. */ static struct { PetscFortranCallbackId creatematrix; PetscFortranCallbackId createglobalvector; PetscFortranCallbackId createlocalvector; PetscFortranCallbackId globaltolocalbegin; PetscFortranCallbackId globaltolocalend; PetscFortranCallbackId localtoglobalbegin; PetscFortranCallbackId localtoglobalend; PetscFortranCallbackId localtolocalbegin; PetscFortranCallbackId localtolocalend; } _cb; static PetscErrorCode ourcreatematrix(DM dm,Mat *A) { PetscObjectUseFortranCallbackSubType(dm,_cb.creatematrix,(DM*,Mat*,PetscErrorCode*),(&dm,A,&ierr)); } static PetscErrorCode ourcreateglobalvector(DM dm,Vec *v) { PetscObjectUseFortranCallbackSubType(dm,_cb.createglobalvector,(DM*,Vec*,PetscErrorCode*),(&dm,v,&ierr)); } static PetscErrorCode ourcreatelocalvector(DM dm,Vec *v) { PetscObjectUseFortranCallbackSubType(dm,_cb.createlocalvector,(DM*,Vec*,PetscErrorCode*),(&dm,v,&ierr)); } static PetscErrorCode ourglobaltolocalbegin(DM dm,Vec g,InsertMode mode,Vec l) { PetscObjectUseFortranCallbackSubType(dm,_cb.globaltolocalbegin,(DM*,Vec*,InsertMode*,Vec*,PetscErrorCode*),(&dm,&g,&mode,&l,&ierr)); } static PetscErrorCode ourglobaltolocalend(DM dm,Vec g,InsertMode mode,Vec l) { PetscObjectUseFortranCallbackSubType(dm,_cb.globaltolocalend,(DM*,Vec*,InsertMode*,Vec*,PetscErrorCode*),(&dm,&g,&mode,&l,&ierr)); } static PetscErrorCode ourlocaltoglobalbegin(DM dm,Vec l,InsertMode mode,Vec g) { PetscObjectUseFortranCallbackSubType(dm,_cb.localtoglobalbegin,(DM*,Vec*,InsertMode*,Vec*,PetscErrorCode*),(&dm,&l,&mode,&g,&ierr)); } static PetscErrorCode ourlocaltoglobalend(DM dm,Vec l,InsertMode mode,Vec g) { PetscObjectUseFortranCallbackSubType(dm,_cb.localtoglobalend,(DM*,Vec*,InsertMode*,Vec*,PetscErrorCode*),(&dm,&l,&mode,&g,&ierr)); } static PetscErrorCode ourlocaltolocalbegin(DM dm,Vec g,InsertMode mode,Vec l) { PetscObjectUseFortranCallbackSubType(dm,_cb.localtolocalbegin,(DM*,Vec*,InsertMode*,Vec*,PetscErrorCode*),(&dm,&g,&mode,&l,&ierr)); } static PetscErrorCode ourlocaltolocalend(DM dm,Vec g,InsertMode mode,Vec l) { PetscObjectUseFortranCallbackSubType(dm,_cb.localtolocalend,(DM*,Vec*,InsertMode*,Vec*,PetscErrorCode*),(&dm,&g,&mode,&l,&ierr)); } PETSC_EXTERN void dmshellsetcreatematrix_(DM *dm,void (*func)(DM*,Mat*,PetscErrorCode*,PETSC_FORTRAN_CHARLEN_T len),PetscErrorCode *ierr) { *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.creatematrix,(PetscVoidFunction)func,NULL);if (*ierr) return; *ierr = DMShellSetCreateMatrix(*dm,ourcreatematrix); } PETSC_EXTERN void dmshellsetcreateglobalvector_(DM *dm,void (*func)(DM*,Vec*,PetscErrorCode*),PetscErrorCode *ierr) { *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.createglobalvector,(PetscVoidFunction)func,NULL);if (*ierr) return; *ierr = DMShellSetCreateGlobalVector(*dm,ourcreateglobalvector); } PETSC_EXTERN void dmshellsetcreatelocalvector_(DM *dm,void (*func)(DM*,Vec*,PetscErrorCode*),PetscErrorCode *ierr) { *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.createlocalvector,(PetscVoidFunction)func,NULL);if (*ierr) return; *ierr = DMShellSetCreateLocalVector(*dm,ourcreatelocalvector); } PETSC_EXTERN void dmshellsetglobaltolocal_(DM *dm,void (*begin)(DM*,Vec*,InsertMode*,Vec*,PetscErrorCode*),void (*end)(DM*,Vec*,InsertMode*,Vec*,PetscErrorCode*),PetscErrorCode *ierr) { *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.globaltolocalbegin,(PetscVoidFunction)begin,NULL);if (*ierr) return; *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.globaltolocalend,(PetscVoidFunction)end,NULL);if (*ierr) return; *ierr = DMShellSetGlobalToLocal(*dm,ourglobaltolocalbegin,ourglobaltolocalend); } PETSC_EXTERN void dmshellsetlocaltoglobal_(DM *dm,void (*begin)(DM*,Vec*,InsertMode*,Vec*,PetscErrorCode*),void (*end)(DM*,Vec*,InsertMode*,Vec*,PetscErrorCode*),PetscErrorCode *ierr) { *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.localtoglobalbegin,(PetscVoidFunction)begin,NULL);if (*ierr) return; *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.localtoglobalend,(PetscVoidFunction)end,NULL);if (*ierr) return; *ierr = DMShellSetLocalToGlobal(*dm,ourlocaltoglobalbegin,ourlocaltoglobalend); } PETSC_EXTERN void dmshellsetlocaltolocal_(DM *dm,void (*begin)(DM*,Vec*,InsertMode*,Vec*,PetscErrorCode*),void (*end)(DM*,Vec*,InsertMode*,Vec*,PetscErrorCode*),PetscErrorCode *ierr) { *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.localtolocalbegin,(PetscVoidFunction)begin,NULL);if (*ierr) return; *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.localtolocalend,(PetscVoidFunction)end,NULL);if (*ierr) return; *ierr = DMShellSetLocalToLocal(*dm,ourlocaltolocalbegin,ourlocaltolocalend); }