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: }