Actual source code: zdmshellf.c

  1: #include <petsc/private/ftnimpl.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:   #define dmshellsetcreatefielddecomposition_ DMSHELLSETCREATEFIELDDECOMPOSITION
 12: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
 13:   #define dmshellsetcreatematrix_             dmshellsetcreatematrix
 14:   #define dmshellsetcreateglobalvector_       dmshellsetcreateglobalvector
 15:   #define dmshellsetcreatelocalvector_        dmshellsetcreatelocalvector
 16:   #define dmshellsetglobaltolocal_            dmshellsetglobaltolocal
 17:   #define dmshellsetlocaltoglobal_            dmshellsetlocaltoglobal
 18:   #define dmshellsetlocaltolocal_             dmshellsetlocaltolocal
 19:   #define dmshellsetcreatefielddecomposition_ dmshellsetcreatefielddecomposition
 20: #endif

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

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

 40: static PetscErrorCode ourcreatematrix(DM dm, Mat *A)
 41: {
 42:   PetscObjectUseFortranCallbackSubType(dm, _cb.creatematrix, (DM *, Mat *, PetscErrorCode *), (&dm, A, &ierr));
 43: }

 45: static PetscErrorCode ourcreateglobalvector(DM dm, Vec *v)
 46: {
 47:   PetscObjectUseFortranCallbackSubType(dm, _cb.createglobalvector, (DM *, Vec *, PetscErrorCode *), (&dm, v, &ierr));
 48: }

 50: static PetscErrorCode ourcreatelocalvector(DM dm, Vec *v)
 51: {
 52:   PetscObjectUseFortranCallbackSubType(dm, _cb.createlocalvector, (DM *, Vec *, PetscErrorCode *), (&dm, v, &ierr));
 53: }

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

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

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

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

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

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

 85: static PetscErrorCode ourcreatefielddecomposition(DM dm, PetscInt *nfields, char ***names, IS **is, DM **subdms)
 86: {
 87:   PetscObjectUseFortranCallbackSubType(dm, _cb.createfielddecomposition, (DM *, PetscInt *, char ***, IS **, DM **, PetscErrorCode *), (&dm, nfields, names, is, subdms, &ierr));
 88: }

 90: PETSC_EXTERN void dmshellsetcreatematrix_(DM *dm, void (*func)(DM *, Mat *, PetscErrorCode *, PETSC_FORTRAN_CHARLEN_T len), PetscErrorCode *ierr)
 91: {
 92:   *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.creatematrix, (PetscVoidFn *)func, NULL);
 93:   if (*ierr) return;
 94:   *ierr = DMShellSetCreateMatrix(*dm, ourcreatematrix);
 95: }

 97: PETSC_EXTERN void dmshellsetcreateglobalvector_(DM *dm, void (*func)(DM *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
 98: {
 99:   *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.createglobalvector, (PetscVoidFn *)func, NULL);
100:   if (*ierr) return;
101:   *ierr = DMShellSetCreateGlobalVector(*dm, ourcreateglobalvector);
102: }

104: PETSC_EXTERN void dmshellsetcreatelocalvector_(DM *dm, void (*func)(DM *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
105: {
106:   *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.createlocalvector, (PetscVoidFn *)func, NULL);
107:   if (*ierr) return;
108:   *ierr = DMShellSetCreateLocalVector(*dm, ourcreatelocalvector);
109: }

111: PETSC_EXTERN void dmshellsetglobaltolocal_(DM *dm, void (*begin)(DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), void (*end)(DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
112: {
113:   *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.globaltolocalbegin, (PetscVoidFn *)begin, NULL);
114:   if (*ierr) return;
115:   *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.globaltolocalend, (PetscVoidFn *)end, NULL);
116:   if (*ierr) return;
117:   *ierr = DMShellSetGlobalToLocal(*dm, ourglobaltolocalbegin, ourglobaltolocalend);
118: }

120: PETSC_EXTERN void dmshellsetlocaltoglobal_(DM *dm, void (*begin)(DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), void (*end)(DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
121: {
122:   *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.localtoglobalbegin, (PetscVoidFn *)begin, NULL);
123:   if (*ierr) return;
124:   *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.localtoglobalend, (PetscVoidFn *)end, NULL);
125:   if (*ierr) return;
126:   *ierr = DMShellSetLocalToGlobal(*dm, ourlocaltoglobalbegin, ourlocaltoglobalend);
127: }

129: PETSC_EXTERN void dmshellsetlocaltolocal_(DM *dm, void (*begin)(DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), void (*end)(DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
130: {
131:   *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.localtolocalbegin, (PetscVoidFn *)begin, NULL);
132:   if (*ierr) return;
133:   *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.localtolocalend, (PetscVoidFn *)end, NULL);
134:   if (*ierr) return;
135:   *ierr = DMShellSetLocalToLocal(*dm, ourlocaltolocalbegin, ourlocaltolocalend);
136: }

138: PETSC_EXTERN void dmshellsetcreatefielddecomposition_(DM *dm, void (*func)(DM *, PetscInt *, char ***, IS **, DM **, PetscErrorCode *), PetscErrorCode *ierr)
139: {
140:   *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.createfielddecomposition, (PetscVoidFn *)func, NULL);
141:   if (*ierr) return;
142:   *ierr = DMShellSetCreateFieldDecomposition(*dm, ourcreatefielddecomposition);
143: }