Actual source code: zdmshellf.c

  1: #include <petsc/private/fortranimpl.h>
  2: #include <petscdmshell.h>

  4: #if defined(PETSC_HAVE_FORTRAN_CAPS)
  5:   #define dmshellsetcreatematrix_       DMSHELLSETCREATEMATRIX
  6:   #define dmshellsetcreateglobalvector_ DMSHELLSETCREATEGLOBALVECTOR_
  7:   #define dmshellsetcreatelocalvector_  DMSHELLSETCREATELOCALVECTOR_
  8:   #define dmshellsetglobaltolocal_      DMSHELLSETGLOBALTOLOCAL_
  9:   #define dmshellsetlocaltoglobal_      DMSHELLSETLOCALTOGLOBAL_
 10:   #define dmshellsetlocaltolocal_       DMSHELLSETLOCALTOLOCAL_
 11: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
 12:   #define dmshellsetcreatematrix_       dmshellsetcreatematrix
 13:   #define dmshellsetcreateglobalvector_ dmshellsetcreateglobalvector
 14:   #define dmshellsetcreatelocalvector_  dmshellsetcreatelocalvector
 15:   #define dmshellsetglobaltolocal_      dmshellsetglobaltolocal
 16:   #define dmshellsetlocaltoglobal_      dmshellsetlocaltoglobal
 17:   #define dmshellsetlocaltolocal_       dmshellsetlocaltolocal_
 18: #endif

 20: /*
 21:  * C routines are required for matrix and global vector creation.  We define C routines here that call the corresponding
 22:  * Fortran routine (indexed by _cb) that was set by the user.
 23:  */

 25: static struct {
 26:   PetscFortranCallbackId creatematrix;
 27:   PetscFortranCallbackId createglobalvector;
 28:   PetscFortranCallbackId createlocalvector;
 29:   PetscFortranCallbackId globaltolocalbegin;
 30:   PetscFortranCallbackId globaltolocalend;
 31:   PetscFortranCallbackId localtoglobalbegin;
 32:   PetscFortranCallbackId localtoglobalend;
 33:   PetscFortranCallbackId localtolocalbegin;
 34:   PetscFortranCallbackId localtolocalend;
 35: } _cb;

 37: static PetscErrorCode ourcreatematrix(DM dm, Mat *A)
 38: {
 39:   PetscObjectUseFortranCallbackSubType(dm, _cb.creatematrix, (DM *, Mat *, PetscErrorCode *), (&dm, A, &ierr));
 40: }

 42: static PetscErrorCode ourcreateglobalvector(DM dm, Vec *v)
 43: {
 44:   PetscObjectUseFortranCallbackSubType(dm, _cb.createglobalvector, (DM *, Vec *, PetscErrorCode *), (&dm, v, &ierr));
 45: }

 47: static PetscErrorCode ourcreatelocalvector(DM dm, Vec *v)
 48: {
 49:   PetscObjectUseFortranCallbackSubType(dm, _cb.createlocalvector, (DM *, Vec *, PetscErrorCode *), (&dm, v, &ierr));
 50: }

 52: static PetscErrorCode ourglobaltolocalbegin(DM dm, Vec g, InsertMode mode, Vec l)
 53: {
 54:   PetscObjectUseFortranCallbackSubType(dm, _cb.globaltolocalbegin, (DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), (&dm, &g, &mode, &l, &ierr));
 55: }

 57: static PetscErrorCode ourglobaltolocalend(DM dm, Vec g, InsertMode mode, Vec l)
 58: {
 59:   PetscObjectUseFortranCallbackSubType(dm, _cb.globaltolocalend, (DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), (&dm, &g, &mode, &l, &ierr));
 60: }

 62: static PetscErrorCode ourlocaltoglobalbegin(DM dm, Vec l, InsertMode mode, Vec g)
 63: {
 64:   PetscObjectUseFortranCallbackSubType(dm, _cb.localtoglobalbegin, (DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), (&dm, &l, &mode, &g, &ierr));
 65: }

 67: static PetscErrorCode ourlocaltoglobalend(DM dm, Vec l, InsertMode mode, Vec g)
 68: {
 69:   PetscObjectUseFortranCallbackSubType(dm, _cb.localtoglobalend, (DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), (&dm, &l, &mode, &g, &ierr));
 70: }

 72: static PetscErrorCode ourlocaltolocalbegin(DM dm, Vec g, InsertMode mode, Vec l)
 73: {
 74:   PetscObjectUseFortranCallbackSubType(dm, _cb.localtolocalbegin, (DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), (&dm, &g, &mode, &l, &ierr));
 75: }

 77: static PetscErrorCode ourlocaltolocalend(DM dm, Vec g, InsertMode mode, Vec l)
 78: {
 79:   PetscObjectUseFortranCallbackSubType(dm, _cb.localtolocalend, (DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), (&dm, &g, &mode, &l, &ierr));
 80: }

 82: PETSC_EXTERN void dmshellsetcreatematrix_(DM *dm, void (*func)(DM *, Mat *, PetscErrorCode *, PETSC_FORTRAN_CHARLEN_T len), PetscErrorCode *ierr)
 83: {
 84:   *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.creatematrix, (PetscVoidFn *)func, NULL);
 85:   if (*ierr) return;
 86:   *ierr = DMShellSetCreateMatrix(*dm, ourcreatematrix);
 87: }

 89: PETSC_EXTERN void dmshellsetcreateglobalvector_(DM *dm, void (*func)(DM *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
 90: {
 91:   *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.createglobalvector, (PetscVoidFn *)func, NULL);
 92:   if (*ierr) return;
 93:   *ierr = DMShellSetCreateGlobalVector(*dm, ourcreateglobalvector);
 94: }

 96: PETSC_EXTERN void dmshellsetcreatelocalvector_(DM *dm, void (*func)(DM *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
 97: {
 98:   *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.createlocalvector, (PetscVoidFn *)func, NULL);
 99:   if (*ierr) return;
100:   *ierr = DMShellSetCreateLocalVector(*dm, ourcreatelocalvector);
101: }

103: PETSC_EXTERN void dmshellsetglobaltolocal_(DM *dm, void (*begin)(DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), void (*end)(DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
104: {
105:   *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.globaltolocalbegin, (PetscVoidFn *)begin, NULL);
106:   if (*ierr) return;
107:   *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.globaltolocalend, (PetscVoidFn *)end, NULL);
108:   if (*ierr) return;
109:   *ierr = DMShellSetGlobalToLocal(*dm, ourglobaltolocalbegin, ourglobaltolocalend);
110: }

112: PETSC_EXTERN void dmshellsetlocaltoglobal_(DM *dm, void (*begin)(DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), void (*end)(DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
113: {
114:   *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.localtoglobalbegin, (PetscVoidFn *)begin, NULL);
115:   if (*ierr) return;
116:   *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.localtoglobalend, (PetscVoidFn *)end, NULL);
117:   if (*ierr) return;
118:   *ierr = DMShellSetLocalToGlobal(*dm, ourlocaltoglobalbegin, ourlocaltoglobalend);
119: }

121: PETSC_EXTERN void dmshellsetlocaltolocal_(DM *dm, void (*begin)(DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), void (*end)(DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
122: {
123:   *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.localtolocalbegin, (PetscVoidFn *)begin, NULL);
124:   if (*ierr) return;
125:   *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.localtolocalend, (PetscVoidFn *)end, NULL);
126:   if (*ierr) return;
127:   *ierr = DMShellSetLocalToLocal(*dm, ourlocaltolocalbegin, ourlocaltolocalend);
128: }